VBA xóa dòng trùng, trống

Chia sẻ bởi:hands

★★★★★

‹ Lấy dữ liệu từ 1 file Excel... tìm các cặp ký tự giống nhau... ›

Quảng cáo

.

[URL='https://www.giaiphapexcel.com/forum/member.php?u=2873']Rất cám ơn lachinhan về trang
https://www.cpearson.com/excel.htm
Trong này có một vài VBA xóa dòng trống, trùng, lấy DM, và rất nhiều hàm. (free)

Public Sub DeleteDuplicateRows()

'[COLOR="Blue"] DeleteDuplicateRows
'chon cot can xoa gt trung[/COLOR]
 Dim R As Long,  N As Long
 Dim V As Variant ,  Rng As Range

On Error GoTo EndMacro
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Set Rng = Application.Intersect(ActiveSheet.UsedRange, _
                    ActiveSheet.Columns(ActiveCell.Column))

Application.StatusBar = "Processing Row: " & Format(Rng.Row, "#,##0")

N = 0
For R = Rng.Rows.Count To 2 Step -1
    If R Mod 500 = 0 Then
         Application.StatusBar = "Processing Row: " & Format(R, "#,##0")
    End If

V = Rng.Cells(R, 1).Value
[COLOR="blue"]' Note that COUNTIF works oddly with a Variant that is equal to vbNullString.
' Rather than pass in the variant, you need to pass in vbNullString explicitly.[/COLOR]
    If V = vbNullString Then
            If Application.WorksheetFunction.CountIf(Rng.Columns(1), vbNullString) > 1 Then
                   Rng.Rows(R).EntireRow.Delete
                   N = N + 1
             End If
     Else
             If Application.WorksheetFunction.CountIf(Rng.Columns(1), V) > 1 Then
                   Rng.Rows(R).EntireRow.Delete
                   N = N + 1
              End If
      End If
Next R

EndMacro:

Application.StatusBar = False
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
MsgBox "Duplicate Rows Deleted: " & CStr(N)

End Sub
'xac dinh vung can delete
Public Sub DeleteBlankRows()

Dim R As Long
Dim C As Range
Dim Rng As Range

On Error GoTo EndMacro
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

If Selection.Rows.Count > 1 Then
    Set Rng = Selection
Else
    Set Rng = ActiveSheet.UsedRange.Rows
End If
For R = Rng.Rows.Count To 1 Step -1
    If Application.WorksheetFunction.CountA(Rng.Rows(R).EntireRow) = 0 Then
        ActiveSheet.Rows(R).EntireRow.Delete
    End If
Next R

EndMacro:

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub

Public Sub DeleteRowOnCell()

On Error Resume Next
Selection.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
ActiveSheet.UsedRange

End Sub