Excel VBA: Xóa dòng Excel dựa trên điều kiện đã xác định

By Lê Quốc Thái

16/10/2020

3

2008

Đánh giá lequocthai.com:

Voted: 5 Votes: 2

Your page rank:

Xóa dòng dựa trên điều kiện

Có nhiều bạn email hỏi mình là: “làm thế nào tôi có thể xóa các dòng khỏi bảng tính Excel của mình dựa trên một tiêu chí hoặc điều kiện được chỉ định?” Dưới đây tôi liệt kê gồm 2 cách nhanh nhất có thể được thực hiện bằng code VBA, ngoài ra việc sử dụng AutoFilter là nhanh nhất và dễ áp dụng nhất cho đến nay. Tuy nhiên nếu bạn muốn pro hơn và học hỏi thêm một tí thì vài code VBA cũng là một ý không tệ chút nào. Cả hai ví dụ đều dựa trên dữ liệu của bạn nằm trong phạm vi liên quan với tiêu chí/điều kiện cần tìm trong cột tương đối của bảng tính do bạn chỉ định. Dòng đầu tiên của bảng tính phải là tiêu đề. Trước khi chạy một trong hai mã VBA, bạn nên chọn bất kỳ ô nào trong bảng của mình.

Option Explicit

Sub DelRows1()

Dim rRange As Range
Dim strCriteria As String
Dim lCol As Long
Dim rHeaderCol As Range
Dim xlCalc As XlCalculation
Const strTitle As String = "LeQuocThai.Com - Dieu kien xoa hang"

    On Error Resume Next
Step1:
    'We use Application.InputBox type 8 so user can select range
    Set rRange = Application.InputBox(Prompt:="Chon vung dieu kien bao gom Tieu de" _
        , Title:=strTitle & " STEP 1 of 3", Default:=ActiveCell.CurrentRegion.Address, Type:=8)
        
    'Cancelled or non valid rage
    If rRange Is Nothing Then Exit Sub
     'Awlays use GoTo when selecting range so doesn't matter which Worksheet
     Application.Goto rRange.Rows(1), True
    
Step2
    'We use Application.InputBox type 1 so return a number
    lCol = Application.InputBox(Prompt:="Vui long dien so Dong va Cot" _
        , Title:=strTitle & " STEP 2 of 3", Default:=1, Type:=1)
        
    'Cancelled
    If lCol = 0 Then Exit Sub

Step3:
    'We use default InputBox type as we want Text
    strCriteria = InputBox(Prompt:="Vui long dien 1 dieu kien." & _
        vbNewLine & "Eg >5 OR <10 OR Cat* OR *Cat OR *Cat*" _
        , Title:=strTitle & " STEP 3 of 3")
        
    If strCriteria = vbNullString Then Exit Sub
    
    'Store current Calculation then switch to manual.
    'Turn off events and screen updating
    With Application
        xlCalc = .Calculation
        .Calculation = xlCalculationManual
        .EnableEvents = False
        .ScreenUpdating = False
    End With
        
    
    'Remove any filters
    ActiveSheet.AutoFilterMode = False
    
    With rRange 'Filter, offset(to exclude headers) and delete visible rows
      .AutoFilter Field:=lCol, Criteria1:=strCriteria
      .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    End With

    'Remove any filters
    ActiveSheet.AutoFilterMode = False
    
      'Revert back
    With Application
        .Calculation = xlCalc
        .EnableEvents = True
        .ScreenUpdating = True
    End With
   On Error GoTo 0
End Sub


Sub DelRows2()

Dim rTable As Range
Dim rCol As Range, rCell As Range
Dim lCol As Long
Dim xlCalc As XlCalculation
Dim vCriteria

On Error Resume Next
   'Determine the table range
     With Selection
         If .Cells.Count > 1 Then
             Set rTable = Selection
         Else
             Set rTable = .CurrentRegion
             On Error GoTo 0
         End If
    End With
   
    'Determine if table range is valid

    If rTable Is Nothing Or rTable.Cells.Count = 1 Or WorksheetFunction.CountA(rTable) < 2 Then
        MsgBox "Khong the xac dinh vung du lieu.", vbCritical, "LeQuocThai.Com"
        Exit Sub
    End If

    'Get the criteria in the form of text or number.

    vCriteria = Application.InputBox(Prompt:="Nhap dieu kien de xoa Dong. " _
    & "Neu dieu kien nam o mot O, clik chon o dieu kien do", _
    Title:="LeQuocThai.Com - Dieu kien xoa Dong", Type:=1 + 2)

    'Go no further if they Cancel.

    If vCriteria = "False" Then Exit Sub

    'Get the relative column number where the criteria should be found

    lCol = Application.InputBox(Prompt:="Chon so luong Cot co lien quan " _
    & "co chua dieu kien xoa.", Title:="LeQuocThai.Com - Dieu kien xoa Dong va Cot", Type:=1)

    'Cancelled
    If lCol = 0 Then Exit Sub
        'Set rCol to the column where criteria should be found
        Set rCol = rTable.Columns(lCol)
        'Set rCell to the first data cell in rCol
        Set rCell = rCol.Cells(2, 1)

    'Store current Calculation then switch to manual.
    'Turn off events and screen updating
    With Application
        xlCalc = .Calculation
        .Calculation = xlCalculationManual
        .EnableEvents = False
        .ScreenUpdating = False
    End With
   
  'Loop and delete as many times as vCriteria exists in rCol
   For lCol = 1 To WorksheetFunction.CountIf(rCol, vCriteria)
        Set rCell = rCol.Find(What:=vCriteria, After:=rCell, LookIn:=xlValues, _
            LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False).Offset(-1, 0)
            rCell.Offset(1, 0).EntireRow.Delete
   Next lCol
   `
    With Application
        .Calculation = xlCalc
        .EnableEvents = True
        .ScreenUpdating = True
    End With
   On Error GoTo 0
   
   End Sub