Code Sổ Chi Tiết Tài Khoản (1 người xem)

DeTong đã viết:

Tham khảo cách làm khác, không cần viết code...
Sheet Info, cell G2: Chọn khoảng thời gian cần xem...
Sheet SCT, cell L2: Chọn loại tài khoản...
Click fải vùng xanh lá, chọn Refresh...

Nhấp chuột vào đây để mở rộng...

hieuvietmy2020 đã viết:

Em cảm ơn Anh/Chị đã hỗ trợ,
tuy nhiên để xử lý nhanh hơn em theo phương án Code ạ.!

Nhấp chuột vào đây để mở rộng...

BuiQuangThuan đã viết:

Số Dư đầu kỳ được tính bằng cách nào thế nhỉ? Code nhiều thế kia mà bạn giải thích có 1 chút thế thì chắc phải chờ người cùng ngành vào giúp thôi

Nhấp chuột vào đây để mở rộng...

hieuvietmy2020 đã viết:

Dạ anh, em cảm ơn anh đã xem bài,

Số dư đầu kỳ được tính khi thỏa điều kiện:
+ Tại Sheets("SCT") lấy 2 điều kiện ở ô L5, C6 để so sánh khớp điều kiện Sheets("NKC"),
+ Tại Sheets("NKC") vùng chứa điều kiện ở cột D + N + O, vùng chứa kết quả cột P,
* Nếu thỏa điều kiện tại cột D + N = P (Tổng số dư Nợ),
* Nếu thỏa điều kiện tại cột D + O = P (Tổng số dư Có),
* Tiếp đó sẽ lấy hiệu Tổng dư Nợ vs Tổng dư Có (Kết quả là hiệu Tổng Số Dư lớn hơn),
Em mong nhận được sự giúp đỡ từ Anh ạ.!

Nhấp chuột vào đây để mở rộng...

            'Ghi du lieu dong So du dau ky
            If DNoDK > DCoDK Then
            .Offset(, 8) = DNoDK - DCoDK:      .Offset(, 9) = 0
            Else
            .Offset(, 9) = DCoDK - DNoDK:      .Offset(, 8) = 0
            End If

hieuvietmy2020 đã viết:

Kính chào Quý Anh Chị Em,

Nhờ Quý Anh Chị Em hỗ trợ giúp em bài code và hướng dẫn thêm giúp em lỗi sai ạ,
- Số dư đầu kỳ: Không cho kết quả theo điều kiện "If (NgayCT < FrD) Then",
- Số dư cuối kỳ: Khi thay đổi thời gian cũng không trả về kết quả,
- Ngoài ra, sau khi hoàn thiện em cần 1 lệnh in tự động nếu "Len(dk) >3"

Em cảm ơn Quý Anh Chị Em đã xem bài ạ.!

Nhấp chuột vào đây để mở rộng...

Sub xyz()
  Application.ScreenUpdating = False
  Dim aNK(), aDK(), res(), TK$, tenSCT$, SDDK#, sdck$
  Dim sR&, i&, eRow&, k&, fDay As Date, eDay As Date

  With Sheets("NKC")
    .AutoFilterMode = False
    i = .Range("P" & .Rows.Count).End(3).Row
    aNK = .Range("D11:P" & i).Value
    .Range("A10:AA" & i).AutoFilter 1
  End With
  sR = UBound(aNK)
  ReDim res(1 To sR, 1 To 10)
 
  With Sheets("SCT")
    fDay = .Range("C6"):   eDay = .Range("C7")
    TK = .Range("L5"):    tenSCT = .Range("M5")
    res(1, 5) = .Range("F10")
    sdck = .Range("F" & .Rows.Count).End(3).Value '   "So du cuoi ky"
  End With
 
  With Sheets("CDPS")
    aDK = .Range("C12", .Range("D" & .Rows.Count).End(3)).Value
  End With
  For i = 1 To UBound(aDK)
    If aDK(i, 1) = TK Then
      tenSCT = tenSCT & TK & " - " & aDK(i, 2)
      Exit For
    End If
  Next i
 

  For i = 1 To sR
    If aNK(i, 1) < fDay Then
      If aNK(i, 11) Like TK & "*" Then
        SDDK = SDDK + aNK(i, 13)
      ElseIf aNK(i, 12) Like TK & "*" Then
        SDDK = SDDK - aNK(i, 13)
      End If
    Else
      Exit For
    End If
  Next i
  If SDDK > 0 Then res(1, 9) = SDDK Else res(1, 10) = -SDDK
 
  k = 1
  For i = i To sR
    If aNK(i, 1) <= eDay Then
      If aNK(i, 11) Like TK & "*" Or aNK(i, 12) Like TK & "*" Then
        k = k + 1
        res(k, 1) = aNK(i, 1): res(k, 2) = aNK(i, 4)
        res(k, 3) = aNK(i, 2): res(k, 4) = aNK(i, 6)
        res(k, 5) = aNK(i, 10)
        If aNK(i, 11) Like TK & "*" Then
          res(k, 6) = aNK(i, 12)
          res(k, 7) = aNK(i, 13)
          SDDK = SDDK + aNK(i, 13)
        Else
          res(k, 6) = aNK(i, 11)
          res(k, 8) = aNK(i, 13)
          SDDK = SDDK - aNK(i, 13)
        End If
        If SDDK > 0 Then res(k, 9) = SDDK Else res(k, 10) = -SDDK
      End If
    Else
      Exit For
    End If
  Next i
  k = k + 1
  res(k, 5) = sdck
  If SDDK > 0 Then res(k, 9) = SDDK Else res(k, 10) = -SDDK
        
  With Sheets("SCT")
    .Range("F5") = tenSCT
    .Range("A10:K" & .Range("F" & .Rows.Count).End(3).Row).Clear
    .Range("B10").Resize(k, 10) = res
    .Range("H10").Resize(k, 4).NumberFormat = "#,###"
    .Range("B10").Resize(k, 10).Borders.LineStyle = 1
  End With
  Application.ScreenUpdating = True
End Sub

pycckuu410 đã viết:

Hoặc bỏ dấu . trước Range. Vì đang trong With Range.

PHP: Sao chép.

            With .Range("B10")
            ....
               
            If DNoDK > DCoDK Then
            .Range("J10") = DNoDK - DCoDK:      .Range("K10") = 0
            Else
            .Range("K10") = DCoDK - DNoDK:      .Range("J10") = 0
            End If
            ...
            End With

Bài đã được tự động gộp: Thứ bảy lúc 10:35

Số chi tiết của bạn còn thiếu sót:
1. Số dư đầu năm chưa được đưa vào code.
2. Chưa sắp sếp dữ liệu phát sinh trong cùng 1 ngày:
- Ví dụ tài khoản Tiền mặt có số dư cuối kỳ bên Nợ: Thì ưu tiên phát sinh bên Nợ trước rồi đến phát sinh bên Có.

Nhấp chuột vào đây để mở rộng...

HieuCD đã viết:

Chạy code

Mã: Sao chép.

Sub xyz()
  Application.ScreenUpdating = False
  Dim aNK(), aDK(), res(), TK$, tenSCT$, SDDK#, sdck$
  Dim sR&, i&, eRow&, k&, fDay As Date, eDay As Date

  With Sheets("NKC")
    .AutoFilterMode = False
    i = .Range("P" & .Rows.Count).End(3).Row
    aNK = .Range("D11:P" & i).Value
    .Range("A10:AA" & i).AutoFilter 1
  End With
  sR = UBound(aNK)
  ReDim res(1 To sR, 1 To 10)
 
  With Sheets("SCT")
    fDay = .Range("C6"):   eDay = .Range("C7")
    TK = .Range("L5"):    tenSCT = .Range("M5")
    res(1, 5) = .Range("F10")
    sdck = .Range("F" & .Rows.Count).End(3).Value '   "So du cuoi ky"
  End With
 
  With Sheets("CDPS")
    aDK = .Range("C12", .Range("D" & .Rows.Count).End(3)).Value
  End With
  For i = 1 To UBound(aDK)
    If aDK(i, 1) = TK Then
      tenSCT = tenSCT & TK & " - " & aDK(i, 2)
      Exit For
    End If
  Next i
 

  For i = 1 To sR
    If aNK(i, 1) < fDay Then
      If aNK(i, 11) Like TK & "*" Then
        SDDK = SDDK + aNK(i, 13)
      ElseIf aNK(i, 12) Like TK & "*" Then
        SDDK = SDDK - aNK(i, 13)
      End If
    Else
      Exit For
    End If
  Next i
  If SDDK > 0 Then res(1, 9) = SDDK Else res(1, 10) = -SDDK
 
  k = 1
  For i = i To sR
    If aNK(i, 1) <= eDay Then
      If aNK(i, 11) Like TK & "*" Or aNK(i, 12) Like TK & "*" Then
        k = k + 1
        res(k, 1) = aNK(i, 1): res(k, 2) = aNK(i, 4)
        res(k, 3) = aNK(i, 2): res(k, 4) = aNK(i, 6)
        res(k, 5) = aNK(i, 10)
        If aNK(i, 11) Like TK & "*" Then
          res(k, 6) = aNK(i, 12)
          res(k, 7) = aNK(i, 13)
          SDDK = SDDK + aNK(i, 13)
        Else
          res(k, 6) = aNK(i, 11)
          res(k, 8) = aNK(i, 13)
          SDDK = SDDK - aNK(i, 13)
        End If
        If SDDK > 0 Then res(k, 9) = SDDK Else res(k, 10) = -SDDK
      End If
    Else
      Exit For
    End If
  Next i
  k = k + 1
  res(k, 5) = sdck
  If SDDK > 0 Then res(k, 9) = SDDK Else res(k, 10) = -SDDK
       
  With Sheets("SCT")
    .Range("F5") = tenSCT
    .Range("A10:K" & .Range("F" & .Rows.Count).End(3).Row).Clear
    .Range("B10").Resize(k, 10) = res
    .Range("H10").Resize(k, 4).NumberFormat = "#,###"
    .Range("B10").Resize(k, 10).Borders.LineStyle = 1
  End With
  Application.ScreenUpdating = True
End Sub

Ngày tháng của tháng 9 có vấn đề, khác dạng với các tháng trước

Nhấp chuột vào đây để mở rộng...