删除行
基本（两个循环）
Sub BasicTwoLoops() ' slow (takes forever)
Const sfRow As Long = 2
Const sCol As String = "A"
Const dfRow As Long = 2
Const dCol As String = "E"
Dim sws As Worksheet: Set sws = Sheet2
Dim slRow As Long: slRow = sws.Cells(sws.Rows.Count, "A").End(xlUp).Row
Dim dws As Worksheet: Set dws = Sheet1
Dim dlRow As Long: dlRow = dws.Cells(dws.Rows.Count, "E").End(xlUp).Row
Dim sValue As Variant
Dim sr As Long
Dim dValue As Variant
Dim dr As Long
For dr = dlRow To dfRow Step -1
dValue = dws.Cells(dr, dCol).Value
For sr = sfRow To slRow
sValue = sws.Cells(sr, sCol).Value
If dValue = sValue Then
dws.Cells(dr, dCol).EntireRow.Delete
Exit For
End If
Next sr
Next dr
End Sub
Application.Match壮举。Range.Union
Sub UseRangesWithUnion() ' fast
' Uses 'RefCombinedRange'
Const sfRow As Long = 2
Const sCol As String = "A"
Const dfRow As Long = 2
Const dCol As String = "E"
Dim sws As Worksheet: Set sws = Sheet2
Dim slRow As Long: slRow = sws.Cells(sws.Rows.Count, "A").End(xlUp).Row
Dim srCount As Long: srCount = slRow - sfRow + 1
Dim srg As Range: Set srg = sws.Cells(sfRow, sCol).Resize(srCount)
Dim dws As Worksheet: Set dws = Sheet1
Dim dlRow As Long: dlRow = dws.Cells(dws.Rows.Count, "E").End(xlUp).Row
Dim drCount As Long: drCount = dlRow - dfRow + 1
Dim drg As Range: Set drg = dws.Cells(dfRow, dCol).Resize(drCount)
Dim sCell As Range
Dim sIndex As Variant
Dim ddrg As Range
Dim dCell As Range
Dim dValue As Variant
For Each dCell In drg.Cells
dValue = dCell.Value
sIndex = Application.Match(dValue, srg, 0)
If IsNumeric(sIndex) Then
Set ddrg = RefCombinedRange(ddrg, dCell)
End If
Next dCell
If ddrg Is Nothing Then Exit Sub
ddrg.EntireRow.Delete
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose: Creates a reference to a range combined from two ranges.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function RefCombinedRange( _
ByVal CombinedRange As Range, _
ByVal AddRange As Range) _
As Range
If CombinedRange Is Nothing Then
Set RefCombinedRange = AddRange
Else
Set RefCombinedRange = Union(CombinedRange, AddRange)
End If
End Function
Range.AutoFilter
Sub UseAutoFilter() ' fastest
' Uses 'GetColumnRange'
' Uses 'ArrStringDataColumn'
' Source headers are not included in the range.
' Destination headers are included in the range.
Const sfRow As Long = 2
Const sCol As String = "A"
Const dfRow As Long = 1 ' Headers included
Const dCol As String = "E"
Dim sws As Worksheet: Set sws = Sheet2
Dim dws As Worksheet: Set dws = Sheet1
Dim slRow As Long: slRow = sws.Cells(sws.Rows.Count, sCol).End(xlUp).Row
Dim srCount As Long: srCount = slRow - sfRow + 1
Dim srg As Range: Set srg = sws.Cells(sfRow, sCol).Resize(srCount)
Dim sData As Variant: sData = GetColumnRange(srg) ' 2D one-based
Dim sArr As Variant: sArr = ArrStringDataColumn(sData, 1) ' 1D zero-based
If IsEmpty(sArr) Then Exit Sub
If dws.AutoFilterMode Then
dws.AutoFilterMode = False
End If
Dim dlRow As Long: dlRow = dws.Cells(dws.Rows.Count, dCol).End(xlUp).Row
Dim drCount As Long: drCount = dlRow - dfRow + 1
Dim drg As Range: Set drg = dws.Cells(dfRow, dCol).Resize(drCount)
Dim ddrg As Range: Set ddrg = drg.Resize(drg.Rows.Count - 1).Offset(1)
drg.AutoFilter 1, sArr, xlFilterValues
On Error Resume Next
ddrg.SpecialCells(xlCellTypeVisible).EntireRow.Delete
On Error GoTo 0
dws.AutoFilterMode = False
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose: Returns the values of a column of a 2D array, converted to
' a string, in an array.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function ArrStringDataColumn( _
ByVal sData As Variant, _
ByVal sColumnIndex As Long, _
Optional ByVal dFirstIndex As Long) _
As Variant
Const ProcName As String = "ArrDataColumn"
On Error GoTo ClearError
Dim sLower As Long: sLower = LBound(sData, 1)
Dim sUpper As Long: sUpper = UBound(sData, 1)
Dim IndexDiff As Long: IndexDiff = sLower - dFirstIndex
Dim dArr As Variant: ReDim dArr(dFirstIndex To sUpper - IndexDiff)
Dim r As Long
For r = sLower To sUpper
dArr(r - IndexDiff) = CStr(sData(r, sColumnIndex))
Next r
ArrStringDataColumn = dArr
ProcExit:
Exit Function
ClearError:
Debug.Print "'" & ProcName & "': Unexpected Error!" & vbLf _
& " " & "Run-time error '" & Err.Number & "':" & vbLf _
& " " & Err.Description
Resume ProcExit
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose: Writes the values from a column ('ColumnNumber')
' of a range ('rg') to a 2D one-based array.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function GetColumnRange( _
ByVal rg As Range, _
Optional ByVal ColumnNumber As Long = 1) _
As Variant
If rg Is Nothing Then Exit Function
If ColumnNumber < 1 Then Exit Function
If ColumnNumber > rg.Columns.Count Then Exit Function
With rg.Columns(ColumnNumber)
If rg.Rows.Count = 1 Then
Dim Data As Variant: ReDim Data(1 To 1, 1 To 1): Data(1, 1) = .Value
GetColumnRange = Data
Else
GetColumnRange = .Value
End If
End With
End Function