Sửa lại code lọc sang sổ cái (1 người xem)

[yome]

Anh/chị sửa dùm lại code lọc sang sổ cái. câu hỏi cụ thể trong file đính kèm!

 

[ThuNghi]

Anh/chị sửa dùm lại code lọc sang sổ cái. câu hỏi cụ thể trong file đính kèm!

1/ Số dư đầu kỳ thì lấy đâu ra
2/ Tên tài khoản ?
Bạn nên đưa thêm 1 sh cân đối phát sinh => lấy số dư đầu kỳ và tên tài khoản.

 

[yome]

1/ Số dư đầu kỳ thì lấy đâu ra
2/ Tên tài khoản ?
Bạn nên đưa thêm 1 sh cân đối phát sinh => lấy số dư đầu kỳ và tên tài khoản.

Anh xem lại dùm em nhé! Em đã thêm Sheet CĐPS nữa rồi đó.

 

[yome]

Xem lại file tôi đã gửi. Đọc tất cả các comment đã ghi trong file sẽ hiểu
Thân

MinhNguyet ơi, file lọc sang sổ cái bạn sửa cho mình đó thì các cột: Ngày, Số Ctừ, Ngày Ctừ nó vẫn hiện 2 dòng dữ liệu. Mình muốn nó chỉ hiện 1 dòng như sổ Nhật ký chung thôi. Như vậy nhìn sẽ đẹp hơn!
Bạn xem và sửa lại dùm mình nhé!

 

[MinhNguyệt]

Anh/chị sửa dùm lại code lọc sang sổ cái. câu hỏi cụ thể trong file đính kèm!

Đã làm cho bạn hôm trước rồi sao nay còn hỏi? Xem lại các comment trong file cũ sẽ biết
Gửi cho luôn theo file mới

 

[ThuNghi]

Đã làm cho bạn hôm trước rồi sao nay còn hỏi? Xem lại các comment trong file cũ sẽ biết
Gửi cho luôn theo file mới

Em thử dùng code tạo sổ cái theo hướng "scripting.dictionary"
Với > 60.000 dòng chạy rất nhanh, nhờ ACE test giúp thử có thể rút gọn.
Code này gán vào file trên của Bác Minh Nguyệt.

Sub TaoSoCai()
Dim i As Long, endR As Long, s As Long, sSHTK As String
Dim ArrData(), MyDic As Object
Dim PSNo, PSCo
Dim TG As Double
TG = Timer
'PSNo = 0: PSCo = 0
With Sheets("Data")
  endR = .Cells(65000, 1).End(xlUp).Row
  ArrData = .Range("A12:H" & endR).Value
End With
Dim ArrSocai(1 To 65000, 1 To 7)
Set MyDic = CreateObject("scripting.dictionary")
With Sheets("SoCai")
  sSHTK = CStr(.Range("F4"))
  .Range("A12:H60000").ClearContents
End With
MyDic.Add sSHTK, ""
For i = 1 To UBound(ArrData)
  If MyDic.Exists(CStr(ArrData(i, 6))) Then
    s = s + 1
    ArrSocai(s, 1) = ArrData(i, 1) 'Ngay GS
    ArrSocai(s, 2) = ArrData(i, 2) 'So CT
    ArrSocai(s, 3) = ArrData(i, 3) 'Ngay CT
    ArrSocai(s, 4) = ArrData(i, 4) 'DienGiai
    ArrSocai(s, 5) = ArrData(i, 7) 'TKDU
    ArrSocai(s, 6) = ArrData(i, 8) 'PS No
    PSNo = PSNo + ArrData(i, 8)
  End If
  If MyDic.Exists(CStr(ArrData(i, 7))) Then
    s = s + 1
    ArrSocai(s, 1) = ArrData(i, 1) 'Ngay GS
    ArrSocai(s, 2) = ArrData(i, 2) 'So CT
    ArrSocai(s, 3) = ArrData(i, 3) 'Ngay CT
    ArrSocai(s, 4) = ArrData(i, 4) 'DienGiai
    ArrSocai(s, 5) = ArrData(i, 6) 'TKDU
    ArrSocai(s, 7) = ArrData(i, 8) ' PSCo
    PSCo = PSCo + ArrData(i, 8)
  End If
Next
With Sheets("socai").Range("A12")
  .Resize(s, 7).Value = ArrSocai
  With .Offset(s, 5)
    .Value = PSNo
  End With
  With .Offset(s, 6)
    .Value = PSCo
  End With
  With .Offset(, 5).Resize(s + 1, 2)
    .NumberFormat = "#,##0"
  End With
End With
Set MyDic = Nothing
Erase ArrData, ArrSocai
MsgBox Format(Timer - TG, "0.000000000") & " seconds"
End Sub