Xin code VBA xóa và ẩn các ô Duplicate (1 người xem)

[manhdan]

Em đang làm file cần loại các dòng có số liệu trùng và ẩn đi. Như file đính kèm sẽ cần xóa dữ liệu các ô bôi màu vàng và ẩn các dòng này đi. Ô E5, E6 tuy trùng số nhưng cùng cột Nợ thì sẽ không xóa:



Em hình dung thuật toán sẽ là: Từ dòng 5 đến 49, nếu E5-F5+E6-F6=0 thì xóa dữ liệu các ô E5, E6, F5, F6, sau đó tiếp tục với E6, F6, E7, F7. Cuối cùng hide tất cả các dòng mà cột E + cột F = 0.

Tuy nhiên em chưa biết chuyển sang ngôn ngữ VBA thế nào, nhờ các anh, chị giúp đỡ ạ.

Em cảm ơn nhiều

 

[manhdan]

Dear các anh, chị.

Sau 1 buổi mò mẫm em cũng đã tự giải quyết bài toán của mình rồi ạ:

Sub Macro2()
'
' Macro2 Macro

' Kiem tra cac o lien hang nhau, neu hieu 2 hang lien tuc = 0 thi xoa
Dim i
Application.ScreenUpdating = False
For i = 5 To 49
    If Range("E" & i).Value - Range("F" & i).Value + Range("E" & i + 1).Value - Range("F" & i + 1).Value = 0 Then
        Range("E" & i & ":F" & i + 1).ClearContents
    End If
Next
Application.ScreenUpdating = True

' Sort du lieu cot G tu cao den thap
ActiveWorkbook.Worksheets("CheckTG").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("CheckTG").AutoFilter.Sort.SortFields.Add Key:= _
        Range("G4:G50"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption _
        :=xlSortNormal
    With ActiveWorkbook.Worksheets("CheckTG").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

' An cac hang ma cot G = 0 hoac bang ""
Dim Rng As Range
  Application.ScreenUpdating = False
    For Each Rng In [G5:G50]
      If Rng.Value = "" Or Rng.Value = 0 Then Rng.EntireRow.Hidden = True
    Next Rng
  Application.ScreenUpdating = True
End Sub

Tuy nhiên hiện tại em mắc 1 vấn đề: Vì dùng hàm lặp nên khi em để range lớn: 2000 dòng chứ không phải 50 dòng thì thời gian chạy rất lâu. Chắc code em không tối ưu nên mới vậy. Nhờ các anh, chị xem giúp em có phương án nào tối ưu hơn không ạ?

 

[killitmore]

Bạn thử xem cái code này đã ổn chưa nhé

Sub remove_dup()
 Dim lrow As Long, i As Long, j As Long


 
 lrow = Cells(Rows.Count, 5).End(xlUp).Row
 
 For i = 5 To lrow
    On Error Resume Next
    j = Application.Match(Cells(i, 5), Range("F1:F" & lrow), 0)
    On Error GoTo 0
    If Abs(i - j) = 1 And Cells(i, 5).Value <> 0 Then
        Range("A" & i & ",A" & j).EntireRow.Hidden = True
    End If
    
    If ((Cells(i, 5).Value + Cells(i + 1, 5).Value = 0) And Cells(i, 5).Value <> 0) Or ((Cells(i, 6).Value + Cells(i + 1, 6).Value = 0) And Cells(i, 6).Value <> 0) Then
        Range(Cells(i, 5), Cells(i + 1, 5)).EntireRow.Hidden = True
    End If
    
 Next i
 
End Sub

 

[manhdan]

Em thử nhưng code trên chỉ ẩn chứ không xóa dữ liệu, hình như có 1 số hàng bị sót nữa.

Nhờ gợi ý lấy lrow trong code của anh em có sửa lại code như bên dưới, chạy 2000 dòng hết 30s em thấy cải thiện được nhiều rồi ạ:

' Kiem tra tu dong 5 den dong cuoi co du lieu, neu hieu 2 dong lien ke = 0 thi xoa so lieu cot E, F:
Dim lrow As Long
lrow = Cells(Rows.Count, 5).End(xlUp).Row
Dim i As Long
Application.ScreenUpdating = False
For i = 5 To lrow
    If Cells(i, 5).Value - Cells(i, 6).Value + Cells(i + 1, 5).Value - Cells(i + 1, 6).Value = 0 Then
        Range("E" & i & ":F" & i + 1).ClearContents
    End If
Next
Application.ScreenUpdating = True

' Sort du lieu cot G tu cao den thap
    ActiveWorkbook.Worksheets("CheckTG").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("CheckTG").AutoFilter.Sort.SortFields.Add Key:= _
        Range("G4:G1999"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption _
        :=xlSortNormal
    With ActiveWorkbook.Worksheets("CheckTG").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

' An cac hang ma cot G = 0 hoac bang ""
lrow = Cells(Rows.Count, 5).End(xlUp).Row
Range(Cells(lrow + 1, 5), Cells(1999, 5)).EntireRow.Hidden = True

Cảm ơn anh nhiều!

 

[manhdan]

Trong quá trình làm em phát hiện ra một số điểm thú vị, xin chia sẻ cùng các anh, chị:

1. Đôi khi dùng công thức

lrow = Cells(Rows.Count, 5).End(xlUp).Row

để tìm ra hàng có dữ liệu cuối cùng lại không chính xác (em cũng chưa hiểu vì sao). Nếu có range cố định thì dùng count cho range sẽ ra số chính xác. Ví dụ:

lrow = Application.Count([E1:E2500])

2. Để tăng tốc độ thì nên ưu tiên dùng hàm có sẵn của excel: có thể tạo thêm cột phụ để hỗ trợ tính, sort và filter dữ liệu..., sau đó có thể dùng vba để xóa các cột này đi. VBA bao giờ cũng chạy chậm hơn formula.

3. Cũng liên quan đến tăng tốc độ vòng lặp thì đoạn code không update giá trị lên màn hình

Application.ScreenUpdating = False
Application.ScreenUpdating = True

lại không giúp ích gì nhiều. Khi em thay bằng đoạn code tắt Automatic Calculation và chỉ bật tự động tính vùng dữ liệu liên quan đến vòng lặp thì tốc động tăng lên rất nhiều.Ví dụ nếu em chỉ bật Automatic Calculation range A5:G2500 thì vòng lặp 2500 dòng ban đầu chạy từ 30 giây giảm xuống còn 5 giây:

Application.Calculation = xlCalculationManual
Range("A5:G2500").Calculate

' Doan code vong lap:
Dim lrow As Long
lrow = Cells(Rows.Count, 5).End(xlUp).Row
Dim i As Long
For i = 5 To lrow
    If Cells(i, 5).Value - Cells(i, 6).Value + Cells(i + 1, 5).Value - Cells(i + 1, 6).Value = 0 Then
        Range("E" & i & ":J" & i + 1).ClearContents
        End If
    End If
Next

Application.Calculation = xlCalculationAutomatic

 

[killitmore]

Code của mình chỉ ẩn dòng đi thôi bạn ạ, còn giữ liệu bị xót thì bạn có thể đưa file đầy đủ lên để mình xem và kiểm tra lại code cho đúng.
Ngoài ra mình xin góp ý 1 chút với 5 điều bạn chia sẻ, mình đánh số thứ tự ứng với các phần bạn đã viết:
1. Tìm dòng cuối đúng hay ko là phụ thuộc vào việc bạn xác định cột nào để tìm dòng cuối cùng, trong code của mình bản chất là mình đến ô cuối cùng có dữ liệu ở cột 5, sau đó lấy dòng của ô đó làm lrow
2. VBA ko phải bao giờ cũng chậm hơn các chức năng sẵn có, code VBA thường được dùng để tối ưu các bước tính toán, nên nó thường được dùng để tăng tốc độ xử lý các cv trong Excel
3. Cái nào cải thiện được nhiều thì tùy vào từng tình huống cụ thể bạn ạ, nói chung bạn cứ dùng cả 2 cho ăn chắc