Làm sổ chi tiết công nợ bằng VBA như thế nào (1 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
minhcong.tckt

minhcong.tckt

Thành viên thường trực
Tham gia
13/4/11
Bài viết
385
Được thích
36
Giới tính
Nam
Em gửi file đính kèm, mong anh chị trong diễn đàn giúp đỡ.
Sheet "NKC": Nơi cập nhật chứng từ theo hình thức nhật ký chung
Sheet "SCTCN": Sổ chi tiết công nợ
Giờ em muốn anh chị thêm code cho sheet "SCTCN" để khi mình đánh mã Tài khoản vào ô D6 và mã khách vào ô D7 thì sổ chi tiết công nợ tương ứng với khách hàng hiện ra (Có vẽ khung viền bảng biểu)
File em gửi là em lấy từ trên mạng về nên chỗ nào thêm code vào anh chị nói rõ cho em hiểu luôn nhé.

Chân thành cảm ơn!!!
 

File đính kèm

Sắp xếp theo thời gian sắp xếp theo bầu chọn
Có ai giúp em với ko ạ
Đây là file gốc, vậy tại Sổ NKC em thêm cột mã khách
còn tại sổ cái em muốn thêm 1 ô mã khách dưới ô mã tài khoản
thì em sửa code như thế nào để có được sổ "công nợ" theo mã khách

Mong các huynh tỷ giúp đỡ.
 

File đính kèm

Upvote 0
minhcong.tckt đã viết:
Em gửi file đính kèm, mong anh chị trong diễn đàn giúp đỡ.
Sheet "NKC": Nơi cập nhật chứng từ theo hình thức nhật ký chung
Sheet "SCTCN": Sổ chi tiết công nợ
Giờ em muốn anh chị thêm code cho sheet "SCTCN" để khi mình đánh mã Tài khoản vào ô D6 và mã khách vào ô D7 thì sổ chi tiết công nợ tương ứng với khách hàng hiện ra (Có vẽ khung viền bảng biểu)
File em gửi là em lấy từ trên mạng về nên chỗ nào thêm code vào anh chị nói rõ cho em hiểu luôn nhé.

Chân thành cảm ơn!!!
Nhấp chuột vào đây để mở rộng...
Híc, muốn giúp lắm nhưng có mấy chỗ không hiểu vì hổng phải dân kế toán dù đã thọ giáo bác Già Gân & Over Ác khoảng....15 phút về mấy cái tài khoản rắc rối này
1 - Tài khoản đối ứng là cái quái gì ??? Có phải khi mình lọc bên "Có" thì tk nằm ngang hàng bên "Nợ" ( và ngược lại ) phải hông ???
2- Ở sheet "SCTCN" nhập vào cell D6 số tài khoản để làm điều kiện lọc, nếu là tài khoản 111 thì lọc bên Nợ hay bên Có ( vì Tk 111 xuất hiện ở cả 2 bên )
Nếu hiểu được thì viết cho bạn cái mới chứ hổng sửa cái cũ của bạn đâu. Nhức đầu lắm
Thân
 
Upvote 0
1 Tài khoản đối ứng là tài khoản nằm cùng hàng với tài khoản cần lọc dữ liệu trên sổ nhật ký chung
VD ở hàng 9 ở "NKC" tài khoản 1561 có tk đối ứng là 111 và ngược lại.
Khi trích lọc tài khoản "156 - sổ cái (Từ Nhật Ký Chung) Nếu TK156 bên nợ thì sang sổ cái 156 số tiền tương ứng cũng nằm bên nợ (2 cột tiền nợ và có )
2. Khi lọc sổ cái 1 tài khoản: VD 111 thì lọc cả bên nợ và bên có của 111 trên 1 bảng có tên là sổ cái tài khoản 111
hàng nào 111 bên nợ thì tiền bên nợ
hàng nào 111 bên có thì tiền bên có của Sổ Cái

Mong anh giúp đỡ
 
Upvote 0
minhcong.tckt đã viết:
1 Tài khoản đối ứng là tài khoản nằm cùng hàng với tài khoản cần lọc dữ liệu trên sổ nhật ký chung
VD ở hàng 9 ở "NKC" tài khoản 1561 có tk đối ứng là 111 và ngược lại.
Khi trích lọc tài khoản "156 - sổ cái (Từ Nhật Ký Chung) Nếu TK156 bên nợ thì sang sổ cái 156 số tiền tương ứng cũng nằm bên nợ (2 cột tiền nợ và có )
2. Khi lọc sổ cái 1 tài khoản: VD 111 thì lọc cả bên nợ và bên có của 111 trên 1 bảng có tên là sổ cái tài khoản 111
hàng nào 111 bên nợ thì tiền bên nợ
hàng nào 111 bên có thì tiền bên có của Sổ Cái
Mong anh giúp đỡ
Nhấp chuột vào đây để mở rộng...
À há !!! hiểu rồi, còn làm trúng trật là ....hên xui thôi
Cột P & Q ở sheet "NKC" là 2 cột mình tạo mã Tài Khoản & Khách hàng cho bạn, nếu có cập nhật thêm thì cứ nhập bình thường trong bảng rồi bấm Ctrl + Q code sẽ cập nhật bỏ vào Validation ở D6 & D7 sheet "SCTCN"
Ở sheet "SCTCN" bạn chọn dữ liệu ở D6 & D7 rồi xem kết quả
Thân
 

File đính kèm

Upvote 0
Làm cho em 1 hàng cuối cùng là tổng cộng Tiền Nợ và Có với ạ?? (Có kẻ viền)
Thay viền liền của anh trong Sổ Cái bằng viền mảnh hơn ( Khung ngoài cùng như vậy là được)
 
Upvote 0
minhcong.tckt đã viết:
Làm cho em 1 hàng cuối cùng là tổng cộng Tiền Nợ và Có với ạ?? (Có kẻ viền)
Thay viền liền của anh trong Sổ Cái bằng viền mảnh hơn ( Khung ngoài cùng như vậy là được)
Nhấp chuột vào đây để mở rộng...
Mấy cái đóng khung này sao bạn không tập ghi Macro rồi dán vào code sẽ được một cái khung như ý, trên cả tuyệt vời
Híc
 

File đính kèm

Upvote 0
Cảm ơn anh rất nhiều, em sẽ cố gắng học thêm VBA
 
Upvote 0
Anh concogia ơi cho em hỏi thêm 1 tý nữa.
Tối qua em về làm thử cách tự ghi macro rồi, nhưng em không biết dán vào code của anh nên phải làm thêm 1 nút bấm nữa, hơi bất tiện 1 tý
Vậy anh giúp em việc này nữa
1. Tại dòng cuối cùng sau dòng cộng nợ có nếu (Số dư đầu tại ô G8 bên Sổ chi tiết)
số dư đầu + phát sinh nợ + phát sinh có >0 thì chữ là DƯ Nợ Cuối kỳ và số tiền
Nếu dư đầu + phát sinh nợ + phát sinh có <0 thì chữ là Dư có cuối kỳ và số tiền
2. Về trình bày bảng biểu
- 3 số cách nhau 1 dấu chấm cho dễ nhìn
- Dưới dòng dư nợ (có) thêm 2:
Ngày tháng năm
Người lập biểu
3. em chỉ tự ghi được macro theo ô xác định ví dụ ô A1...chứ chưa xác định được ô, hàng luôn thay đổi như hàng tổng cộng, dư cuối kỳ
Mong anh giúp đỡ thêm
 
Upvote 0
minhcong.tckt đã viết:
Anh concogia ơi cho em hỏi thêm 1 tý nữa.
Tối qua em về làm thử cách tự ghi macro rồi, nhưng em không biết dán vào code của anh nên phải làm thêm 1 nút bấm nữa, hơi bất tiện 1 tý
Vậy anh giúp em việc này nữa
1. Tại dòng cuối cùng sau dòng cộng nợ có nếu (Số dư đầu tại ô G8 bên Sổ chi tiết)
số dư đầu + phát sinh nợ + phát sinh có >0 thì chữ là DƯ Nợ Cuối kỳ và số tiền
Nếu dư đầu + phát sinh nợ + phát sinh có <0 thì chữ là Dư có cuối kỳ và số tiền
2. Về trình bày bảng biểu
- 3 số cách nhau 1 dấu chấm cho dễ nhìn
- Dưới dòng dư nợ (có) thêm 2:
Ngày tháng năm
Người lập biểu
3. em chỉ tự ghi được macro theo ô xác định ví dụ ô A1...chứ chưa xác định được ô, hàng luôn thay đổi như hàng tổng cộng, dư cuối kỳ
Mong anh giúp đỡ thêm
Nhấp chuột vào đây để mở rộng...
1/ Làm sổ chi tiết công nợ thì phần chọn shtk chỉ giới hạn ở những tk công nợ, cụ thể TK 131, 331...Không cần chọn hết các TK, nếu những TK khác mà không có MaKH => treo.
2/ Nên lập thêm 1 sh DMKH => đối tượng chọn mã KH
3/ Bạn muốn mẫu sổ thế nào thì nên thiết kế trước mẫu sổ, chớ Bác concogia đâu phải là kế toán mà yêu cầu Bác có số PS nợ, Có và số dư ...
 
Upvote 0
Mình vừa làm sổ chi tiết Mẫu,
ThuNghi tải file đính kèm tại bài #7 giúp mình có được ko (nghe bạn nói, mình biết bạn có hiểu biết về kế toán
 

File đính kèm

Upvote 0
minhcong.tckt đã viết:
Mình vừa làm sổ chi tiết Mẫu,
ThuNghi tải file đính kèm tại bài #7 giúp mình có được ko (nghe bạn nói, mình biết bạn có hiểu biết về kế toán
Nhấp chuột vào đây để mở rộng...
Cơ sở nào bạn lấy được số dư đầu kỳ.
Bạn muốn tạo sổ CT công nợ theo tháng hay là theo ngày.
 
Upvote 0
ThuNghi đã viết:
Cơ sở nào bạn lấy được số dư đầu kỳ.
Bạn muốn tạo sổ CT công nợ theo tháng hay là theo ngày.
Nhấp chuột vào đây để mở rộng...

Mình sẽ tạo 1 bảng gọi là bảng " cân đối phát sinh công nợ" - số dư đầu kỳ được lấy từ đó
Theo ngày đi bạn, liên tục cập nhật sổ chi tiết công nợ
 
Upvote 0
Nếu cột 2 sh NKC (ngày) < fD thì số liệu sẽ được tính là số dư đầu.
Bạn xem file.
Lần sau nếu tạo mẫu sổ thì tạo bài bản.
Hy vọng bạn vận dụng được file sau.
 

File đính kèm

Upvote 0
Cảm ơn ThuNghi, mình sẽ vận dụng file của bạn
 
Upvote 0
Bạn ơi cho mình hỏi trong code bạn gửi cho mình thì
CLng (); CStr() là gì vậy, cách vận dụng như thế nào??? mình chưa rõ cho lắm
 
Upvote 0
Upvote 0
nó ra một cái khung nhưng mình đọc không hiểu, mong bạn giải thích cho mình hiểu hơn
 
Upvote 0
ThuNghi đã viết:
Nếu cột 2 sh NKC (ngày) < fD thì số liệu sẽ được tính là số dư đầu.
Bạn xem file.
Lần sau nếu tạo mẫu sổ thì tạo bài bản.
Hy vọng bạn vận dụng được file sau.
Nhấp chuột vào đây để mở rộng...

ThuNghi cho mình hỏi là ngày tháng (từ ngày đến ngày) bên Sổ Chi Tiết được so sánh với cột ngày tháng nào bên NKC, cột B hay cột D,
 
Lần chỉnh sửa cuối:
Upvote 0
Tại "NKC" mình thay cột ngày tháng (Cột B) bằng cột "KH" thì tại " Sổ chi tiết công nợ" ấn vào nút thì báo lỗi
ThuNghi sửa lỗi cho mình với nhé

Chân thành cảm ơn
 

File đính kèm

Upvote 0
minhcong.tckt đã viết:
Tại "NKC" mình thay cột ngày tháng (Cột B) bằng cột "KH" thì tại " Sổ chi tiết công nợ" ấn vào nút thì báo lỗi
ThuNghi sửa lỗi cho mình với nhé

Chân thành cảm ơn
Nhấp chuột vào đây để mở rộng...
Sửa trong phần đầu code
PHP: 
Const cNg = 2
thành
PHP: 
Const cNg = 4
Lý do là bạn sửa cấu trúc sh NKC ngày HT là cột 2 thành cột 4 nên code kg hiểu.
 
Upvote 0
concogia đã viết:
À há !!! hiểu rồi, còn làm trúng trật là ....hên xui thôi
Cột P & Q ở sheet "NKC" là 2 cột mình tạo mã Tài Khoản & Khách hàng cho bạn, nếu có cập nhật thêm thì cứ nhập bình thường trong bảng rồi bấm Ctrl + Q code sẽ cập nhật bỏ vào Validation ở D6 & D7 sheet "SCTCN"
Ở sheet "SCTCN" bạn chọn dữ liệu ở D6 & D7 rồi xem kết quả
Thân
Nhấp chuột vào đây để mở rộng...
"Tải file đính kèm tại #5"
Anh ơi cho em hỏi, nếu Cột Mã Khách là cột L chứ ko phải cột I thì sửa code như thế nào
Có phải sửa
If Vung(i, 5) = [D6] And Vung(i, 11) = [D7] Then
Nhấp chuột vào đây để mở rộng...
thay vì 8 ??? em thay thành 11 thì code báo lỗi.
Mong anh giúp đỡ
 
Lần chỉnh sửa cuối:
Upvote 0
nhờ các bác giúp. do em gộp chung mã khách hàng vào trong 2 cột định khoản là bằng dấu # (ví dụ: 131#BaoV; 331#ThangL...) còn nhưng tài khoản kia vẫn dùng bình thường, em đã áp dụng được vào sổ chi tiết khách hàng bằng cách bỏ điều kiện mã khách hàng, nhưng khi dùng mã này để chạy thêm 1 sổ chi tiết tài khoản, thì em muốn dùng điều kiện là những tài khoản trước dấu "#" để lên sổ chi tiết tài khoản thì phải sửa lệnh như nào ạ. em định dùng hàm left nhưng em có những tài khoản loại 1 có 3 ký tự, loại 2 có 4 ký tự, loại 3 có 5 ký tự ... nên không khả thi lắm ạ.
 
Upvote 0
Bài gần nhất cách đây cũng đã hơn 7 năm, nên:
Bạn nên dẫn ra file đang ở bài nào trong mớ các bài trên
Hay là đưa file giả lập lên
Hoặc Mua chục li cà fê & nhâm nhi hết số đó may ra . . . . có người trong ngành hỗ trợ bạn!

Chúc ngày cuối tuần vui vẻ!
 
Upvote 0
SA_DQ đã viết:
Bài gần nhất cách đây cũng đã hơn 7 năm, nên:
Bạn nên dẫn ra file đang ở bài nào trong mớ các bài trên
Hay là đưa file giả lập lên
Hoặc Mua chục li cà fê & nhâm nhi hết số đó may ra . . . . có người trong ngành hỗ trợ bạn!

Chúc ngày cuối tuần vui vẻ!
Nhấp chuột vào đây để mở rộng...
dạ vâng ạ. hy vong mọi người giúp em với ạ!
 

File đính kèm

Upvote 0
theanhst92 đã viết:
dạ vâng ạ. hy vong mọi người giúp em với ạ!
Nhấp chuột vào đây để mở rộng...
Dùng Left(Tài khoản chi tiết,Len(TK cấp trên)) = TK cấp trên
M7 nhập '131
Mã: 
Option Explicit
Dim endR&, fD&, eD&, i&, s&, k&, sokytuTK&
Dim sTK$, sMaKH$, tkNo$, tkCo$
Dim SoDu As Double
Dim Arr(), ArrKQ()
Const cNg = 2: Const cTkNo = 7: Const cTkCo = 8: Const cST = 9
Sub TaoSoCT()
With Sheets("NLPS")
  .AutoFilterMode = False
  endR = .Cells(65000, 2).End(3).Row
  Arr = .Range("A6:J" & endR).Value 'Arr la vung du lieu
End With
With Sheets("SCTTK")
  .Rows("13:200").EntireRow.Hidden = False
  .Range("C13:I200").ClearContents
  .[H12] = 0: .[I12] = 0
  fD = CLng(.[M5]):  eD = CLng(.[M6])
  sTK = CStr(.[M7]): sokytuTK = Len(sTK)
End With
s = 0: SoDu = 0
ReDim ArrKQ(1 To 200, 1 To 7)
For i = 1 To UBound(Arr)
    tkNo = Left(Arr(i, cTkNo), sokytuTK)
    tkCo = Left(Arr(i, cTkCo), sokytuTK)
    If tkNo = sTK Or tkCo = sTK Then
      If CLng(Arr(i, cNg)) <= eD Then
        Select Case fD
          Case Is > CLng(Arr(i, cNg)) 'Sodu
            Select Case sTK
              Case Is = tkNo
                SoDu = SoDu + Arr(i, cST)
              Case Is = tkCo
                SoDu = SoDu - Arr(i, cST)
            End Select
          Case Is <= CLng(Arr(i, cNg)) 'PS
            s = s + 1
            For k = 1 To 4
              ArrKQ(s, k) = Arr(i, k + 1)
            Next k
            Select Case sTK
              Case Is = tkNo 'PSNo
                ArrKQ(s, 5) = Arr(i, cTkCo)
                ArrKQ(s, 6) = Arr(i, cST) 'ST PS No
              Case Is = tkCo 'PSCo
                ArrKQ(s, 5) = Arr(i, cTkNo)
                ArrKQ(s, 7) = Arr(i, cST) 'STPS Co
            End Select
        End Select
      End If
    End If
Next i
If s = 0 Then
  MsgBox "Kg co"
  GoTo Exit_Sub
End If
With Sheets("SCTTK")
 .Rows(s + 14 & ":200").EntireRow.Hidden = True
  If SoDu > 0 Then
    .[H12] = SoDu: .[I12] = 0
  Else
    .[I12] = -SoDu: .[H12] = 0
  End If
 '.Range("A11:G200").ClearContents
 .[C13].Resize(s, 7) = ArrKQ
End With
Exit_Sub:
Erase Arr(), ArrKQ()
End Sub
 
Upvote 0
HieuCD đã viết:
Dùng Left(Tài khoản chi tiết,Len(TK cấp trên)) = TK cấp trên
M7 nhập '131
Mã: 
Option Explicit
Dim endR&, fD&, eD&, i&, s&, k&, sokytuTK&
Dim sTK$, sMaKH$, tkNo$, tkCo$
Dim SoDu As Double
Dim Arr(), ArrKQ()
Const cNg = 2: Const cTkNo = 7: Const cTkCo = 8: Const cST = 9
Sub TaoSoCT()
With Sheets("NLPS")
  .AutoFilterMode = False
  endR = .Cells(65000, 2).End(3).Row
  Arr = .Range("A6:J" & endR).Value 'Arr la vung du lieu
End With
With Sheets("SCTTK")
  .Rows("13:200").EntireRow.Hidden = False
  .Range("C13:I200").ClearContents
  .[H12] = 0: .[I12] = 0
  fD = CLng(.[M5]):  eD = CLng(.[M6])
  sTK = CStr(.[M7]): sokytuTK = Len(sTK)
End With
s = 0: SoDu = 0
ReDim ArrKQ(1 To 200, 1 To 7)
For i = 1 To UBound(Arr)
    tkNo = Left(Arr(i, cTkNo), sokytuTK)
    tkCo = Left(Arr(i, cTkCo), sokytuTK)
    If tkNo = sTK Or tkCo = sTK Then
      If CLng(Arr(i, cNg)) <= eD Then
        Select Case fD
          Case Is > CLng(Arr(i, cNg)) 'Sodu
            Select Case sTK
              Case Is = tkNo
                SoDu = SoDu + Arr(i, cST)
              Case Is = tkCo
                SoDu = SoDu - Arr(i, cST)
            End Select
          Case Is <= CLng(Arr(i, cNg)) 'PS
            s = s + 1
            For k = 1 To 4
              ArrKQ(s, k) = Arr(i, k + 1)
            Next k
            Select Case sTK
              Case Is = tkNo 'PSNo
                ArrKQ(s, 5) = Arr(i, cTkCo)
                ArrKQ(s, 6) = Arr(i, cST) 'ST PS No
              Case Is = tkCo 'PSCo
                ArrKQ(s, 5) = Arr(i, cTkNo)
                ArrKQ(s, 7) = Arr(i, cST) 'STPS Co
            End Select
        End Select
      End If
    End If
Next i
If s = 0 Then
  MsgBox "Kg co"
  GoTo Exit_Sub
End If
With Sheets("SCTTK")
.Rows(s + 14 & ":200").EntireRow.Hidden = True
  If SoDu > 0 Then
    .[H12] = SoDu: .[I12] = 0
  Else
    .[I12] = -SoDu: .[H12] = 0
  End If
'.Range("A11:G200").ClearContents
.[C13].Resize(s, 7) = ArrKQ
End With
Exit_Sub:
Erase Arr(), ArrKQ()
End Sub
Nhấp chuột vào đây để mở rộng...
Nếu dùng như vậy thì bí dụ khi em cần chi tiết tài khoản 1111 hay là 13881 thì lại phải chỉnh lại mã này ạ
 
Upvote 0
HieuCD đã viết:
Mình chỉ chỉnh code cho chạy đúng theo bài #23, không can thiệp cách chạy code thế nào
Nhấp chuột vào đây để mở rộng...
dạ vâng. tại em cũng đã dùng hàm left để lấy điều kiện của biến theo số ký tự cần dùng rồi, nhưng do tài khoản có nhiều cấp nên thành ra phát sinh như vậy, có cách nào để tách ký tự sau dấu # ra khỏi điều kiện không ạ.
 
Upvote 0
theanhst92 đã viết:
dạ vâng. tại em cũng đã dùng hàm left để lấy điều kiện của biến theo số ký tự cần dùng rồi, nhưng do tài khoản có nhiều cấp nên thành ra phát sinh như vậy, có cách nào để tách ký tự sau dấu # ra khỏi điều kiện không ạ.
Nhấp chuột vào đây để mở rộng...
" có cách nào để tách ký tự sau dấu # ra khỏi điều kiện" nói rỏ hơn của vùng dữ liệu nào?
 
Upvote 0
HieuCD đã viết:
Code mình đã tách rồi mờ
Nhấp chuột vào đây để mở rộng...
dạ đúng ý em rồi ạ. tại xem mã k để ý thành ra viết lại k đúng như bác sửa cho. em cảm ơn ạ

HieuCD đã viết:
" có cách nào để tách ký tự sau dấu # ra khỏi điều kiện" nói rỏ hơn của vùng dữ liệu nào?
Nhấp chuột vào đây để mở rộng...
vậy để tách chuỗi sau ký tự "#" thì viết như nào ạ. nhờ bác chỉ giúp em với ạ.
 
Upvote 0
em có sửa một chút để dùng mã này copy dữ liệu. nhưng do muốn tách mã chi tiết trong định khoản ra để dùng làm biến nên chưa nghĩ ra hướng làm. đành thêm vào điều kiện cụ thể là
If CStr("331#" & DSKH(i, cMaKH)) = ArrKQ(1, 6) _
Or CStr("3383#" & DSKH(i, cMaKH)) = ArrKQ(1, 6) _
Or CStr("131#" & DSKH(i, cMaKH)) = ArrKQ(1, 6) Then
nhưng như vậy nếu phát sinh khác có lẽ không khả thi lắm. nhờ bác giúp em ạ
Mã: 
Sub UNC_AGR()
With Sheets("NLPS")
  .AutoFilterMode = False
  endR = .Cells(65000, 2).End(3).Row
  Arr = .Range("A6:U" & endR).Value
End With
With Sheets("DSKH")
  .AutoFilterMode = False
  DSKH = .Range("A3:J" & endR).Value
End With
With Sheets("UNC_AGR")
'  .Rows("72:90").EntireRow.Hidden = False
  .Range("T80:AH90").ClearContents
  sTK = CStr(.[T7])
End With
S = 0
ReDim ArrKQ(1 To 10, 1 To 8)
For i = 1 To UBound(Arr)
SCtu = CStr(Arr(i, cSoCT))
    If SCtu = sTK Then
            S = S + 1
            For K = 1 To 8
              ArrKQ(S, K) = Arr(i, K + 1)
            Next K
    End If
Next i
R = 0
ReDim dskhKQ(1 To 10, 1 To 6)
For i = 1 To UBound(DSKH)
    If CStr("331#" & DSKH(i, cMaKH)) = ArrKQ(1, 6) _
    Or CStr("3383#" & DSKH(i, cMaKH)) = ArrKQ(1, 6) _
    Or CStr("131#" & DSKH(i, cMaKH)) = ArrKQ(1, 6) Then
        R = R + 1
        For K = 1 To 6
            dskhKQ(R, K) = DSKH(i, K + 1)
        Next K
    End If
Next i
If S = 0 Then
  MsgBox (CHUYENMA("So phieu khong hop le"))
  GoTo Exit_Sub
End If
If R = 0 Then
  MsgBox (CHUYENMA("Chua co ma khach hang"))
  GoTo Exit_Sub
End If
With Sheets("UNC_AGR")
' .Rows(S + 82 & ":90").EntireRow.Hidden = True
 .[T80].Resize(S, 8) = ArrKQ
 .[AB80].Resize(R, 6) = dskhKQ
End With
Exit_Sub:
Erase Arr(), ArrKQ(), dskhKQ()
End Sub
 
Upvote 0
theanhst92 đã viết:
em có sửa một chút để dùng mã này copy dữ liệu. nhưng do muốn tách mã chi tiết trong định khoản ra để dùng làm biến nên chưa nghĩ ra hướng làm. đành thêm vào điều kiện cụ thể là
If CStr("331#" & DSKH(i, cMaKH)) = ArrKQ(1, 6) _
Or CStr("3383#" & DSKH(i, cMaKH)) = ArrKQ(1, 6) _
Or CStr("131#" & DSKH(i, cMaKH)) = ArrKQ(1, 6) Then
nhưng như vậy nếu phát sinh khác có lẽ không khả thi lắm. nhờ bác giúp em ạ
Mã: 
Sub UNC_AGR()
With Sheets("NLPS")
  .AutoFilterMode = False
  endR = .Cells(65000, 2).End(3).Row
  Arr = .Range("A6:U" & endR).Value
End With
With Sheets("DSKH")
  .AutoFilterMode = False
  DSKH = .Range("A3:J" & endR).Value
End With
With Sheets("UNC_AGR")
'  .Rows("72:90").EntireRow.Hidden = False
  .Range("T80:AH90").ClearContents
  sTK = CStr(.[T7])
End With
S = 0
ReDim ArrKQ(1 To 10, 1 To 8)
For i = 1 To UBound(Arr)
SCtu = CStr(Arr(i, cSoCT))
    If SCtu = sTK Then
            S = S + 1
            For K = 1 To 8
              ArrKQ(S, K) = Arr(i, K + 1)
            Next K
    End If
Next i
R = 0
ReDim dskhKQ(1 To 10, 1 To 6)
For i = 1 To UBound(DSKH)
    If CStr("331#" & DSKH(i, cMaKH)) = ArrKQ(1, 6) _
    Or CStr("3383#" & DSKH(i, cMaKH)) = ArrKQ(1, 6) _
    Or CStr("131#" & DSKH(i, cMaKH)) = ArrKQ(1, 6) Then
        R = R + 1
        For K = 1 To 6
            dskhKQ(R, K) = DSKH(i, K + 1)
        Next K
    End If
Next i
If S = 0 Then
  MsgBox (CHUYENMA("So phieu khong hop le"))
  GoTo Exit_Sub
End If
If R = 0 Then
  MsgBox (CHUYENMA("Chua co ma khach hang"))
  GoTo Exit_Sub
End If
With Sheets("UNC_AGR")
' .Rows(S + 82 & ":90").EntireRow.Hidden = True
.[T80].Resize(S, 8) = ArrKQ
.[AB80].Resize(R, 6) = dskhKQ
End With
Exit_Sub:
Erase Arr(), ArrKQ(), dskhKQ()
End Sub
Nhấp chuột vào đây để mở rộng...
Không có file nên không biết Sheets("UNC_AGR") có gì trong đó, rủi có người đẹp trong đó thì mệt lắm
 
Upvote 0
theanhst92 đã viết:
dạ em xin gửi file cụ thể ạ.
Nhấp chuột vào đây để mở rộng...
Chỉnh code
Mã: 
Sub TaoSoCT()
With Sheets("NLPS")
  .AutoFilterMode = False
  endR = .Cells(65000, 2).End(3).Row
  Arr = .Range("A6:J" & endR).Value 'Arr la vung du lieu
End With
With Sheets("SCTTK")
  .Rows("13:200").EntireRow.Hidden = False
  .Range("C13:I200").ClearContents
  .[H12] = 0: .[I12] = 0
  fD = CLng(.[M5]):  eD = CLng(.[M6])
  sTK = CStr(.[M7])
  If InStr(1, sTK, "#") > 0 Then
    sTK = Mid(sTK, 1, InStr(1, sTK, "#") - 1)
  End If
  sokytuTK = Len(sTK)
End With
S = 0: SoDu = 0
ReDim ArrKQ(1 To 200, 1 To 7)
For i = 1 To UBound(Arr)
    TkNo = Left(Arr(i, cTkNo), sokytuTK)
    TkCo = Left(Arr(i, cTkCo), sokytuTK)
    If TkNo = sTK Or TkCo = sTK Then
      If CLng(Arr(i, cNg)) <= eD Then
        Select Case fD
          Case Is > CLng(Arr(i, cNg)) 'Sodu
            Select Case sTK
              Case Is = TkNo
                SoDu = SoDu + Arr(i, cST)
              Case Is = TkCo
                SoDu = SoDu - Arr(i, cST)
            End Select
          Case Is <= CLng(Arr(i, cNg)) 'PS
            S = S + 1
            For K = 1 To 4
              ArrKQ(S, K) = Arr(i, K + 1)
            Next K
            Select Case sTK
              Case Is = TkNo 'PSNo
                ArrKQ(S, 5) = Arr(i, cTkCo)
                ArrKQ(S, 6) = Arr(i, cST) 'ST PS No
              Case Is = TkCo 'PSCo
                ArrKQ(S, 5) = Arr(i, cTkNo)
                ArrKQ(S, 7) = Arr(i, cST) 'STPS Co
            End Select
        End Select
      End If
    End If
Next i
If S = 0 Then
  MsgBox "Kg co"
  GoTo Exit_Sub
End If
With Sheets("SCTTK")
 .Rows(S + 14 & ":200").EntireRow.Hidden = True
  If SoDu > 0 Then
    .[H12] = SoDu: .[I12] = 0
  Else
    .[I12] = -SoDu: .[H12] = 0
  End If
 '.Range("A11:G200").ClearContents
 .[C13].Resize(S, 7) = ArrKQ
End With
Exit_Sub:
Erase Arr(), ArrKQ()
End Sub
Sub còn lại thiếu nhiều lệnh nên không biết làm gì. Gởi kết quả làm tay và mục đich code
 
Upvote 0
HieuCD đã viết:
Chỉnh code
Mã: 
Sub TaoSoCT()
With Sheets("NLPS")
  .AutoFilterMode = False
  endR = .Cells(65000, 2).End(3).Row
  Arr = .Range("A6:J" & endR).Value 'Arr la vung du lieu
End With
With Sheets("SCTTK")
  .Rows("13:200").EntireRow.Hidden = False
  .Range("C13:I200").ClearContents
  .[H12] = 0: .[I12] = 0
  fD = CLng(.[M5]):  eD = CLng(.[M6])
  sTK = CStr(.[M7])
  If InStr(1, sTK, "#") > 0 Then
    sTK = Mid(sTK, 1, InStr(1, sTK, "#") - 1)
  End If
  sokytuTK = Len(sTK)
End With
S = 0: SoDu = 0
ReDim ArrKQ(1 To 200, 1 To 7)
For i = 1 To UBound(Arr)
    TkNo = Left(Arr(i, cTkNo), sokytuTK)
    TkCo = Left(Arr(i, cTkCo), sokytuTK)
    If TkNo = sTK Or TkCo = sTK Then
      If CLng(Arr(i, cNg)) <= eD Then
        Select Case fD
          Case Is > CLng(Arr(i, cNg)) 'Sodu
            Select Case sTK
              Case Is = TkNo
                SoDu = SoDu + Arr(i, cST)
              Case Is = TkCo
                SoDu = SoDu - Arr(i, cST)
            End Select
          Case Is <= CLng(Arr(i, cNg)) 'PS
            S = S + 1
            For K = 1 To 4
              ArrKQ(S, K) = Arr(i, K + 1)
            Next K
            Select Case sTK
              Case Is = TkNo 'PSNo
                ArrKQ(S, 5) = Arr(i, cTkCo)
                ArrKQ(S, 6) = Arr(i, cST) 'ST PS No
              Case Is = TkCo 'PSCo
                ArrKQ(S, 5) = Arr(i, cTkNo)
                ArrKQ(S, 7) = Arr(i, cST) 'STPS Co
            End Select
        End Select
      End If
    End If
Next i
If S = 0 Then
  MsgBox "Kg co"
  GoTo Exit_Sub
End If
With Sheets("SCTTK")
.Rows(S + 14 & ":200").EntireRow.Hidden = True
  If SoDu > 0 Then
    .[H12] = SoDu: .[I12] = 0
  Else
    .[I12] = -SoDu: .[H12] = 0
  End If
'.Range("A11:G200").ClearContents
.[C13].Resize(S, 7) = ArrKQ
End With
Exit_Sub:
Erase Arr(), ArrKQ()
End Sub
Sub còn lại thiếu nhiều lệnh nên không biết làm gì. Gởi kết quả làm tay và mục đich code
Nhấp chuột vào đây để mở rộng...
chết em quên mất là cái điều kiện em cần là ở sub sau, còn sub trước em làm theo bác hướng dẫn đuược rồi. :(
em xin gửi lại file có ghi rõ điều muốn, mong đc bác giúp thêm ạ
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
HieuCD đã viết:
Có kết quả làm bằng tay mới biết bạn làm gì
Nhấp chuột vào đây để mở rộng...
em tự nghĩ ra sau khi xem code của bác cũng đã cho ra kết quả khả quan. em tách biến bằng độ dài của biến - vị trí của ký tự "#" thì ra đc độ dài cần tìm của chuỗi từ bên phải (dùng hàm right). nhìn hơi lủng củng nhưng có vẻ khả thi. hy vọng nhận được góp ý của bác ạ.
Mã: 
If CStr(DSKH(i, cMaKH)) = Right(ArrKQ(1, 6), (Len(ArrKQ(1, 6)) - InStr(1, ArrKQ(1, 6), "#"))) Then
 
Upvote 0
theanhst92 đã viết:
em tự nghĩ ra sau khi xem code của bác cũng đã cho ra kết quả khả quan. em tách biến bằng độ dài của biến - vị trí của ký tự "#" thì ra đc độ dài cần tìm của chuỗi từ bên phải (dùng hàm right). nhìn hơi lủng củng nhưng có vẻ khả thi. hy vọng nhận được góp ý của bác ạ.
Mã: 
If CStr(DSKH(i, cMaKH)) = Right(ArrKQ(1, 6), (Len(ArrKQ(1, 6)) - InStr(1, ArrKQ(1, 6), "#"))) Then
Nhấp chuột vào đây để mở rộng...
Không biết bạn muốn làm gì làm sao góp ýo_O
 
Upvote 0
em xin gửi lại file có ghi rõ điều muốn, mong đc giúp thêm ạ :D
ở sheet này, hiện tại em đang dùng lệnh để tim thông tin khách hàng từ cột i
nhưng do trên định khoản là 131#HoaD mà trên danh khách tài khoản thì mã của nó chỉ là HoaD
nên em phải gán thêm 131# vào biến để đúng điều kiện tìm
có cách nào để không phải gán 131# vào biến bằng cách xóa bỏ ký tự trước dấu # tại điều kiện để tim mã kH đc không ạ
Nhấp chuột vào đây để mở rộng...
Thứ nhất: Đầu câu nên viết hoa để mọi người tôn trọng bạn & bạn tôn trọng mọi người.
Thứ 2:
Muốn tìm HoaD trong cột I, trong trong cột này chứa các trị 131#HoaD hay 133#HoaD thì ta xài phương thức FIND() trong VBA, như câu lệnh được trích dẫn dưới đây:
Set sRng = [I8].Resize(10^4).Find(Sheets("DSKH").[B7].Value, ,xlFormulas, xlPart)
If Not sRng Is Nothing Then Msgbox sRng.Value
 
Upvote 0
SA_DQ đã viết:
Thứ nhất: Đầu câu nên viết hoa để mọi người tôn trọng bạn & bạn tôn trọng mọi người.
Thứ 2:
Muốn tìm HoaD trong cột I, trong trong cột này chứa các trị 131#HoaD hay 133#HoaD thì ta xài phương thức FIND() trong VBA, như câu lệnh được trích dẫn dưới đây:
Set sRng = [I8].Resize(10^4).Find(Sheets("DSKH").[B7].Value, ,xlFormulas, xlPart)
If Not sRng Is Nothing Then Msgbox sRng.Value
Nhấp chuột vào đây để mở rộng...
Dạ em cảm ơn bác, em xin rút kinh nghiệm ạ!
 
Upvote 0
Em có một vấn đề nhờ các bác giúp đỡ là làm sao để tính được số dư lũy kế theo từng dòng phát sinh trong bảng theo dõi công nợ ạ!
 
Upvote 0
HieuCD đã viết:
Dùng Left(Tài khoản chi tiết,Len(TK cấp trên)) = TK cấp trên
M7 nhập '131
Mã: 
Option Explicit
Dim endR&, fD&, eD&, i&, s&, k&, sokytuTK&
Dim sTK$, sMaKH$, tkNo$, tkCo$
Dim SoDu As Double
Dim Arr(), ArrKQ()
Const cNg = 2: Const cTkNo = 7: Const cTkCo = 8: Const cST = 9
Sub TaoSoCT()
With Sheets("NLPS")
  .AutoFilterMode = False
  endR = .Cells(65000, 2).End(3).Row
  Arr = .Range("A6:J" & endR).Value 'Arr la vung du lieu
End With
With Sheets("SCTTK")
  .Rows("13:200").EntireRow.Hidden = False
  .Range("C13:I200").ClearContents
  .[H12] = 0: .[I12] = 0
  fD = CLng(.[M5]):  eD = CLng(.[M6])
  sTK = CStr(.[M7]): sokytuTK = Len(sTK)
End With
s = 0: SoDu = 0
ReDim ArrKQ(1 To 200, 1 To 7)
For i = 1 To UBound(Arr)
    tkNo = Left(Arr(i, cTkNo), sokytuTK)
    tkCo = Left(Arr(i, cTkCo), sokytuTK)
    If tkNo = sTK Or tkCo = sTK Then
      If CLng(Arr(i, cNg)) <= eD Then
        Select Case fD
          Case Is > CLng(Arr(i, cNg)) 'Sodu
            Select Case sTK
              Case Is = tkNo
                SoDu = SoDu + Arr(i, cST)
              Case Is = tkCo
                SoDu = SoDu - Arr(i, cST)
            End Select
          Case Is <= CLng(Arr(i, cNg)) 'PS
            s = s + 1
            For k = 1 To 4
              ArrKQ(s, k) = Arr(i, k + 1)
            Next k
            Select Case sTK
              Case Is = tkNo 'PSNo
                ArrKQ(s, 5) = Arr(i, cTkCo)
                ArrKQ(s, 6) = Arr(i, cST) 'ST PS No
              Case Is = tkCo 'PSCo
                ArrKQ(s, 5) = Arr(i, cTkNo)
                ArrKQ(s, 7) = Arr(i, cST) 'STPS Co
            End Select
        End Select
      End If
    End If
Next i
If s = 0 Then
  MsgBox "Kg co"
  GoTo Exit_Sub
End If
With Sheets("SCTTK")
.Rows(s + 14 & ":200").EntireRow.Hidden = True
  If SoDu > 0 Then
    .[H12] = SoDu: .[I12] = 0
  Else
    .[I12] = -SoDu: .[H12] = 0
  End If
'.Range("A11:G200").ClearContents
.[C13].Resize(s, 7) = ArrKQ
End With
Exit_Sub:
Erase Arr(), ArrKQ()
End Sub
Nhấp chuột vào đây để mở rộng...
Em có một vấn đề nhờ bác giúp đỡ ạ. em có sử dụng mã của trên của các bác để áp dụng vào làm file sổ cái. nhưng khi những dữ liệu mà phát sinh chung tài khoản mẹ trong một một nghiệp vụ thì lệnh trên lại chỉ lấy đc 1 định khoản. không lấy được cả 2 (ví dụ như khi định khoản nợ là 1121 và định khoản có là 1122 thì sổ cái tài khoản 112 chỉ ghi được 1 phát sinh.) mong được bác sửa lại giúp với ạ. em cảm ơn các bác!
 
Upvote 0
mrbomst đã viết:
Em có một vấn đề nhờ bác giúp đỡ ạ. em có sử dụng mã của trên của các bác để áp dụng vào làm file sổ cái. nhưng khi những dữ liệu mà phát sinh chung tài khoản mẹ trong một một nghiệp vụ thì lệnh trên lại chỉ lấy đc 1 định khoản. không lấy được cả 2 (ví dụ như khi định khoản nợ là 1121 và định khoản có là 1122 thì sổ cái tài khoản 112 chỉ ghi được 1 phát sinh.) mong được bác sửa lại giúp với ạ. em cảm ơn các bác!
Nhấp chuột vào đây để mở rộng...
Chỉnh lại vòng For
Mã: 
For i = 1 To UBound(Arr)
    tkNo = Left(Arr(i, cTkNo), sokytuTK)
    tkCo = Left(Arr(i, cTkCo), sokytuTK)
    If tkNo = sTK Or tkCo = sTK Then
      If CLng(Arr(i, cNg)) <= eD Then
        Select Case fD
          Case Is > CLng(Arr(i, cNg)) 'Sodu
            If sTK = tkNo Then SoDu = SoDu + Arr(i, cST)
            If sTK = tkCo Then SoDu = SoDu - Arr(i, cST)
          Case Is <= CLng(Arr(i, cNg)) 'PS
            If sTK = tkNo Then 'PSNo
              s = s + 1
              For k = 1 To 4
                ArrKQ(s, k) = Arr(i, k + 1)
              Next k
              ArrKQ(s, 5) = Arr(i, cTkCo)
              ArrKQ(s, 6) = Arr(i, cST) 'ST PS No
            End If
            If sTK = tkCo Then 'PSCo
              s = s + 1
              For k = 1 To 4
                ArrKQ(s, k) = Arr(i, k + 1)
              Next k
              ArrKQ(s, 5) = Arr(i, cTkNo)
              ArrKQ(s, 7) = Arr(i, cST) 'ST PS Co
            End If
        End Select
      End If
    End If
Next i
 
Upvote 0
HieuCD đã viết:
Chỉnh lại vòng For
Mã: 
For i = 1 To UBound(Arr)
    tkNo = Left(Arr(i, cTkNo), sokytuTK)
    tkCo = Left(Arr(i, cTkCo), sokytuTK)
    If tkNo = sTK Or tkCo = sTK Then
      If CLng(Arr(i, cNg)) <= eD Then
        Select Case fD
          Case Is > CLng(Arr(i, cNg)) 'Sodu
            If sTK = tkNo Then SoDu = SoDu + Arr(i, cST)
            If sTK = tkCo Then SoDu = SoDu - Arr(i, cST)
          Case Is <= CLng(Arr(i, cNg)) 'PS
            If sTK = tkNo Then 'PSNo
              s = s + 1
              For k = 1 To 4
                ArrKQ(s, k) = Arr(i, k + 1)
              Next k
              ArrKQ(s, 5) = Arr(i, cTkCo)
              ArrKQ(s, 6) = Arr(i, cST) 'ST PS No
            End If
            If sTK = tkCo Then 'PSCo
              s = s + 1
              For k = 1 To 4
                ArrKQ(s, k) = Arr(i, k + 1)
              Next k
              ArrKQ(s, 5) = Arr(i, cTkNo)
              ArrKQ(s, 7) = Arr(i, cST) 'ST PS Co
            End If
        End Select
      End If
    End If
Next i
Nhấp chuột vào đây để mở rộng...
Em cảm ơn anh ạ!
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.

Bài viết mới nhất

D
XIN PHẦN MỀM XẾP TKB TIỂU HỌC BẰNG EXCEL (1 người xem)
Trả lời
0
Đọc
16
danhpheo
D
H
Tự động cập nhật dữ liệu từ 2 file word (1 người xem)
Trả lời
1
Đọc
49
LOGANWover
L
N
Nhờ giúp Drop down list theo tỉnh xã mới.
Trả lời
7
Đọc
225
ongke0711
ongke0711
E
VBA copy ô trong excel khi đang lọc filter (1 người xem)
Trả lời
8
Đọc
106
eagle12
E
R
Các bác có kinh nghiệm excel cho em xin công thức đánh số thứ tự theo ngày tháng này vợi ạ.
Trả lời
4
Đọc
95
HieuCD
H
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba (2 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
3 4 5
Trả lời
436
Đọc
57K
hangiang
H
N
Không sử dụng được phím tắt Ctrl + Shift + mũi tên xuống
Trả lời
1
Đọc
3K
aFdangthacmac
A
L
  • Question Question
Gõ và chọn tên trong ComboBox hiển thị giá trị trong textbox
    • Cười
Trả lời
8
Đọc
365
ongke0711
ongke0711
befaint
[ Python và ứng dụng ] Công cụ trích xuất hàng loạt hóa đơn điện tử XML vào bảng Excel
    • Thích
    • Yêu thích
    • Cảm ơn
Trả lời
56
Đọc
9K
Hoale85
H
Nam168
Không mở được file excel
Trả lời
2
Đọc
67
Nam168
Nam168
V
Quản lý xuất nhập vật tư trong kho
Trả lời
14
Đọc
531
LOGANWover
L
phuongnam366377
Sử dụng COM DLL **không cần đăng ký** với Delphi 12 / C++ Builder (1 người xem)
    • Thích
Trả lời
0
Đọc
81
phuongnam366377
phuongnam366377
N
Định mức nguyên vật liệu
Trả lời
49
Đọc
5K
ntan50
N
H
  • Question Question
Dò tìm giá trị từ bảng khác theo cột
Trả lời
6
Đọc
287
Chả_biết_gì
C
2
  • Question Question
Hỏi cách in phiếu điều tra PCGD-XMC từ file dữ liệu mẫu xuất ra từ hệ thống PCGD-XMC của Bộ GD (1 người xem)
    • Thích
Trả lời
26
Đọc
1K
haitien123
H
ongke0711
Truy cập trang GPE chậm (1 người xem)
    • Thích
Trả lời
3
Đọc
194
Hai Lúa Miền Tây
Hai Lúa Miền Tây
V
Gộp File Từng File Excel vào 1 File
Trả lời
16
Đọc
492
ptm0412
ptm0412
Gà Con yêu VBA
Mở Pass file excel phiên bản .xlsx , xlsm, xlsb
Trả lời
10
Đọc
800
Zizi One
Zizi One
I
Phân bổ số lượng xuất kho trong kỳ theo từng mã nguyên vật liệu
Trả lời
6
Đọc
211
IrisQ
I
L
Các bạn giúp mình hoàn thiện công thức hàm sumif nhé (1 người xem)
Trả lời
5
Đọc
174
lequang_qn
L
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Thời gian đếm ngược.

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom