Sao không ai đọc rồi trả lời vậy ạ ( Em có tìm được đoạn code của anh HoangDanh từ mấy năm trước nhưng dùng vào Nhật ký chung của công ty em thì kết quả vẫn bị lệch. Ai cho em xin ý kiến vớiiiiiiiii! CODE:
Sub Taoso() Dim i As Long, Rw As Long, t As Double Dim Chungtu As Range, Ci8 As Range, Ci9 As Range Dim DK1 As Boolean, Dk2 As Boolean, Dk3 As Boolean, Dk4 As
Boolean Application.ScreenUpdating = False t = Timer Range("A7:I65536").ClearContents With Sheets("DATA") Rw = .[D65536].End(xlUp).Row Set Chungtu = .Range("A7:A" & Rw) End With With Chungtu .Resize(, 4).Copy Destination:=[A7] .Offset(, 6).Copy Destination:=[G7] .Offset(, 4).Resize(, 2).Copy Destination:=[H7] End With Set Chungtu = Nothing For i = 7 To [D65536].End(xlUp).Row With Cells(i, 5) Set Ci8 = .Offset(, 3): Set Ci9 =
.Offset(, 4) DK1 = ((Cells(i, 1) = Cells(i + 1, 1)) * (.Offset(, 3) > 0)) = 1 Dk2 = ((Cells(i, 1) = Cells(i - 1, 1)) * (.Offset(, 3) > 0)) = 1 Dk3 = ((Cells(i, 1) = Cells(i + 1, 1)) * (.Offset(, 4) > 0)) = 1 Dk4 = ((Cells(i, 1) = Cells(i - 1, 1)) * (.Offset(, 4) > 0)) = 1 '------------------------------------------------------------------------------------- '1a.> 1 No 1 Co voi No truoc If DK1 And Ci8 = Cells(i + 1, 9) Then .Value = Cells(i + 1,
4) '1b.> 1 No 1 Co voi Co truoc ElseIf Dk2 And Ci8 = Cells(i - 1, 9) Then .Value = Cells(i - 1, 4) '2a.> 2 No 1 Co voi No truoc ElseIf DK1 And Ci8 + Cells(i + 1, 8-) = Cells(i + 2, 9) Then .Value = Cells(i + 2, 4) ElseIf DK1 And Ci8 + Cells(i - 1, 8-) = Cells(i + 1, 9) Then .Value = Cells(i + 1, 4) '2b.> 2 No 1 Co voi Co truoc ElseIf Dk2 And Ci8 + Cells(i + 1, 8-) = Cells(i - 1, 9) Then .Value = Cells(i - 1, 4) ElseIf Dk2 And Ci8 + Cells(i
- 1, 8-) = Cells(i - 2, 9) Then .Value = Cells(i - 2, 4) '3a.> 3 No 1 Co voi No truoc ElseIf DK1 And Ci8 + Cells(i + 1, 8-) + Cells(i + 2, 8-) = Cells(i + 3, 9) Then .Value = Cells(i + 3, 4) ElseIf DK1 And Ci8 + Cells(i - 1, 8-) + Cells(i + 1, 8-) = Cells(i + 2, 9) Then .Value = Cells(i + 2, 4) ElseIf DK1 And Ci8 + Cells(i - 1, 8-) + Cells(i - 2, 8-) = Cells(i + 1, 9) Then .Value = Cells(i + 1, 4) '3b.> 3 No 1 Co voi Co truoc ElseIf DK1 And Ci8 +
Cells(i + 1, 8-) + Cells(i + 2, 8-) = Cells(i - 1, 9) Then .Value = Cells(i - 1, 4) ElseIf DK1 And Ci8 + Cells(i + 1, 8-) + Cells(i - 1, 8-) = Cells(i - 2, 9) Then .Value = Cells(i - 2, 4) ElseIf Dk2 And Ci8 + Cells(i - 1, 8-) + Cells(i - 2, 8-) = Cells(i - 3, 9) Then .Value = Cells(i - 3, 4) 'Tu truong hop 4a tro ve sau thuat toan se khac, do la dao chieu giua No va Co '4a.> 1 No 2 Co voi No truoc ElseIf Dk3 And Cells(i + 1, 9) <> 0 And Ci9 + Cells(i +
1, 9) = Cells(i - 1, 8-) Then .Value = .Offset(, -1) .Offset(, -1) = .Offset(-1, -1) ElseIf Dk4 And Ci9 + Cells(i - 1, 9) = Cells(i - 2, 8-) Then .Value = .Offset(, -1) .Offset(, -1) = .Offset(-2, -1) '4b.> 1 No 2 Co voi Co truoc ElseIf Dk3 And Cells(i + 1, 9) <> 0 And Ci9 + Cells(i + 1, 9) = Cells(i + 2, 8-) Then .Value = .Offset(, -1) .Offset(, -1) = .Offset(2, -1) ElseIf Dk3 And Cells(i - 1, 9) <> 0 And Ci9 + Cells(i - 1, 9) = Cells(i +
1, 8-) Then .Value = .Offset(, -1) .Offset(, -1) = .Offset(1, -1) '5a.> 1 No 3 Co voi No truoc ElseIf Dk3 And Cells(i + 1, 9) <> 0 And Ci9 + Cells(i + 1, 9) + Cells(i + 2, 9) = Cells(i - 1, 8-) Then .Value = .Offset(, -1) .Offset(, -1) = .Offset(-1, -1) ElseIf Dk3 And Cells(i + 1, 9) <> 0 And Ci9 + Cells(i + 1, 9) + Cells(i - 1, 9) = Cells(i - 2, 8-) Then .Value = .Offset(, -1) .Offset(, -1) = .Offset(-2, -1) ElseIf Dk4 And Cells(i - 1, 9)
<> 0 And Ci9 + Cells(i - 1, 9) + Cells(i - 2, 9) = Cells(i - 3, 8-) Then .Value = .Offset(, -1) .Offset(, -1) = .Offset(-3, -1) '5b.> 1 No 3 Co voi Co truoc ElseIf Dk3 And Cells(i + 1, 9) <> 0 And Ci9 + Cells(i + 1, 9) + Cells(i + 2, 9) = Cells(i + 3, 8-) Then .Value = .Offset(, -1) .Offset(, -1) = .Offset(3, -1) ElseIf Dk3 And Cells(i + 1, 9) <> 0 And Ci9 + Cells(i + 1, 9) + Cells(i - 1, 9) = Cells(i + 2, 8-) Then .Value = .Offset(, -1)
.Offset(, -1) = .Offset(2, -1) ElseIf Dk3 And Cells(i - 1, 9) <> 0 And Ci9 + Cells(i - 1, 9) + Cells(i - 2, 9) = Cells(i + 1, 8-) Then .Value = .Offset(, -1) .Offset(, -1) = .Offset(1, -1) End If '------------------------------------------------------------------------------------- If .Value <> "" And .Offset(, -1) <> "" Then .Offset(, 1).Value = Ci8 + Ci9 End With Next i Set Ci8 = Nothing: Set Ci9 = Nothing DelRow ' Huy dong lenh nay de
xem va sua chua cac thuat toan o tren [A2] = Timer - t [A6:G6].AutoFilter Application.ScreenUpdating = True End Sub '============================================================================================= Sub DelRow() Dim Cell As Range, Rng As Range, r As Long Set Rng = Range("F7:F" & [D65536].End(xlUp).Row) For Each Cell In Rng Cell.Offset(, 2).Value = Cell.Row If Cell.Value = 0 Then Cell.EntireRow.Clear Next Range("A7:H65536").Sort
key1:=[H7], order1:=xlAscending [D765536].HorizontalAlignment = xlCenter [E7:E65536].HorizontalAlignment = xlCenter [G7:G65536].HorizontalAlignment = xlCenter [F7:F65536].NumberFormat = "#,##0" Columns("H:I").Clear Set Rng = Nothing: Set Cell = Nothing End Sub '============================================================================================= Sub test() Dim ChungtuData As Range, SotienData As Range, ChungtuConvert As Range, SotienConvert As
Range Dim Cell As Range, t As Double Application.ScreenUpdating = False t = Timer [A265536].Clear [B1] = "Chung tu" With Sheets("DATA") Set ChungtuData = .Range("A7:A" & .[A65536].End(xlUp).Row) Set SotienData = ChungtuData.Offset(, 4) End With ChungtuData.Copy Destination:=[B2] [B1:B65536].AdvancedFilter Action:=xlFilterCopy, CopyToRange:=[A1], Unique:=True [B2:B65536].Clear [B1] = "DATA" With Sheets("Convert") Set ChungtuConvert =
.Range("A7:A" & .[A65536].End(xlUp).Row) Set SotienConvert = ChungtuConvert.Offset(, 5) End With For Each Cell In Range("A2:A" & [A65536].End(xlUp).Row) If Cell <> "" Then Cell.Offset(, 1) = WorksheetFunction.SumIf(ChungtuData, Cell, SotienData) Cell.Offset(, 2) = WorksheetFunction.SumIf(ChungtuConvert, Cell, SotienConvert) Cell.Offset(, 3) = Cell.Offset(, 1) - Cell.Offset(, 2) End If Next [E1] = Timer - t [A11].AutoFilter Set
ChungtuData = Nothing: Set SotienData = Nothing Set ChungtuConvert = Nothing: Set SotienConvert = Nothing Application.ScreenUpdating = True End Sub '============================================================================================== Sub Taosocai() Dim Cell As Range, r As Long, t As Double, DK1 As Boolean, Ngay1 As Boolean, Ngay2 As Boolean Application.ScreenUpdating = False t = Timer: [A7:G65536].ClearContents: r = 7 If Not IsDate([B2]) Or Not
IsDate([B3]) Then Exit Sub With Sheets("Convert") For Each Cell In .Range("A7:A" & .[A65536].End(xlUp).Row) If Cell.Offset(, 1).Row = 5 Then MsgBox "Sheet Convert chua co du lieu!": Exit Sub If Not IsDate(Cell.Offset(, 1)) Then MsgBox "Gia tri ngay trong Cell : Convert!" & Cell.Offset(, 1).Address & " Khong dung": Exit Sub Ngay1 = DateValue(Cell.Offset(, 1)) >= DateValue([B2]) Ngay2 = DateValue(Cell.Offset(, 1)) <= DateValue([B3]) DK1 = InStr(1,
Cell.Offset(, 3), [F3], 1) = 1 If DK1 Or InStr(1, Cell.Offset(, 4), [F3], 1) = 1 Then Select Case [C3] Case 0 Cells(r, 1) = Cell Cells(r, 2) = Cell.Offset(, 1) Cells(r, 3) = Cell.Offset(, 2) If DK1 Then Cells(r, 4) = Cell.Offset(, 4) Cells(r, 5) = Cell.Offset(, 5) Else Cells(r, 4) = Cell.Offset(, 3) Cells(r, 6) = Cell.Offset(, 5) End If Cells(r, 7) = Cell.Offset(, 6) r = r + 1 Case 1 If Ngay1 * Ngay2 = 1 Then Cells(r, 1) =
Cell Cells(r, 2) = Cell.Offset(, 1) Cells(r, 3) = Cell.Offset(, 2) If DK1 Then Cells(r, 4) = Cell.Offset(, 4) Cells(r, 5) = Cell.Offset(, 5) Else Cells(r, 4) = Cell.Offset(, 3) Cells(r, 6) = Cell.Offset(, 5) End If Cells(r, 7) = Cell.Offset(, 6) r = r + 1 End If End Select Cells(r, 4).HorizontalAlignment = xlCenter Cells(r, 5).NumberFormat = "#,##0" Cells(r, 6).NumberFormat = "#,##0" Cells(r, 7).HorizontalAlignment =
xlCenter End If Next End With [C3] = 0 [G3] = Timer - t [A6:G6].AutoFilter Application.ScreenUpdating = True End Sub