Dữ liệu của bạn trong nhật ký chung bạn nhập không có nguyên tắc về dòng, hàng gì cả, như thế sẽ rất gây khó khăn trong việc tổng hợp dữ liệu sau này.
Dựa trên dữ liệu của bạn tôi có làm tổng hợp sang sổ cái, bạn tham khảo theo file đính kèm,
Bạn chọn số TK tại ô F5 rồi nhấn Click.
Tôi sử dụng ADO để tổng hợp
[GPECODE=vb]Sub Truysuat()
Dim Cnn As New ADODB.Connection
Dim Recd As New ADODB.Recordset
Dim Cnnstr As String
Dim MySQL As String
Dim Myfile As String
Application.ScreenUpdating = False
Myfile = ThisWorkbook.Path & "\" & ThisWorkbook.Name
'Tao ket noi
If Val(Application.Version) < 12 Then
Cnnstr = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source= " & Myfile & ";Extended Properties=""Excel 8.0;HDR=No;IMEX=1"""
Else
Cnnstr = "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & Myfile & ";Extended Properties=""Excel 12.0;HDR=No;IMEX=1"""
End If
Cnn.Open Cnnstr
'Tao record truy suat du lieu
MySQL = "SELECT f1 ,f2 ,f3 ,f4 , f5 , f7,0 FROM [Data]" & Chr(13) & "WHERE f6 LIKE '" & _
Sheets("SOCAI111").[F5].Text & "%'"
MySQL = MySQL & Chr(13) & "UNION ALL" & Chr(13)
MySQL = MySQL & "SELECT f1 ,f2 ,f3 ,f4 , f6 , 0,f8 FROM [Data] WHERE f5 LIKE '" & _
Sheets("SOCAI111").[F5].Text & "%'"
MySQL = MySQL & Chr(13) & "ORDER BY f1"
Recd.Open MySQL, Cnn
'Kiem tra co du lieu khong
If Recd.EOF Then MsgBox "Khong co phat sinh trong ky", vbOKOnly
'Copy du lieu truy suat duoc
Sheets("SOCAI111").[9:119].Clear
Sheets("SOCAI111").[A9].CopyFromRecordset Recd
Cells.Select
Selection.Font.Name = ".VnTime"
Range("F5").Select
Application.ScreenUpdating = True
'Giai phong bo nho
If Recd.State = adStateOpen Then
Recd.Close: Set Recd = Nothing
End If
Cnn.Close: Set Cnn = Nothing
MsgBox "Hoan thanh!", vbOKOnly
End Sub
[/GPECODE]