我正在嘗試比較兩個產品串列。如果從 Sheet2 進行匹配，我想洗掉 Sheet1 中的整行。
Sheet1（有 17226 行）
ITEMID WAREHOUSEID QUANTITY UNIT PRICE LOCATIONID
1000 1 100 EA 1.00 30
1001 1 100 EA 1.00 30
1002 1 100 EA 1.00 30
1003 1 100 EA 1.00 30
1004 1 100 EA 1.00 30
1005 1 100 EA 1.00 30
1006 1 100 EA 1.00 30
1007 1 100 EA 1.00 30
1008 1 100 EA 1.00 30
Sheet2（有 977 行）
1002
1004
1006
1008
我相信如果我遍歷 Sheet2 的 A 列中的值并將它們與 Sheet1 中的每個 ITEMID（這是 Sheet1 中的 E 列）進行比較，它會起作用。
我寫了這段代碼，但它似乎沒有做任何事情：
Sub Delete()
Dim LastRow As Long
Dim i As Long
Dim rngCell As Range
LastRow = Range("Sheet1!E17226").End(xlUp).Row
For Each rngCell In Range("Sheet2!A1:A977")
For i = LastRow To 1 Step -1
If Range("E" & i).Value = rngCell.Value Then
Range("E" & i).EntireRow.Delete
End If
Next
Next
End Sub
請指出我的錯誤，以便我可以修復并運行 VBA 腳本，謝謝。
uj5u.com熱心網友回復：
洗掉行
基本（兩個回圈）
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
uj5u.com熱心網友回復：
也許是這樣的？
請注意Range參考的明確程度。例如，If Range("E" & i).Value在您的代碼中，該 Range 物件隱式附加到ActiveSheet，它可以是 Shee1 或 Sheet2。
Public Sub Delete()
Dim rng1 As Range, rng2 As Range, r1 As Range, r2 As Range
Set rng1 = ThisWorkbook.Worksheets("Sheet1").Range("A1:A17226")
Set rng2 = ThisWorkbook.Worksheets("Sheet2").Range("A1:A997")
For Each r2 In rng2
Set r1 = rng1.Find(What:=r2.Value, LookAt:=xlWhole)
If Not r1 Is Nothing Then
r1.EntireRow.Delete
End If
Next
End Sub
轉載請註明出處，本文鏈接：https://www.uj5u.com/qukuanlian/314265.html