Làm sổ chi tiết công nợ bằng VBA như thế nào

[minhcong.tckt]

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!!!

 

[theanhst92]

Có kết quả làm bằng tay mới biết bạn làm gì

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 ạ.

If CStr(DSKH(i, cMaKH)) = Right(ArrKQ(1, 6), (Len(ArrKQ(1, 6)) - InStr(1, ArrKQ(1, 6), "#"))) Then

 

[HieuCD]

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 ạ.

If CStr(DSKH(i, cMaKH)) = Right(ArrKQ(1, 6), (Len(ArrKQ(1, 6)) - InStr(1, ArrKQ(1, 6), "#"))) Then

Không biết bạn muốn làm gì làm sao góp ý

 

[SA_DQ]

em xin gửi lại file có ghi rõ điều muốn, mong đc giúp thêm ạ
ở 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 ạ

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

 

[theanhst92]

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

Dạ em cảm ơn bác, em xin rút kinh nghiệm ạ!

 

[mrbomst]

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ợ ạ!

 

[mrbomst]

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

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

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!

 

[HieuCD]

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!

Chỉnh lại vòng For

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

 

[mrbomst]

Chỉnh lại vòng For

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

Em cảm ơn anh ạ!