Question

我有两张纸，Sheet1和sheet2。

表1是我的资料表，我在A栏中提到了项目编号。

工作表2是我的目标工作表，其中包含数据库中的项目编号列表。

我将源表的A列与目标表的E列进行比较，如果它们都有相同的项目编号，那么我将删除整行。

我正在使用以下代码。 6号项目4被删除，2项未被删除。

但是，当我将相同的项目编号从目标工作表复制到源工作表时，它将被删除。我不确定为什么会这样。任何人都可以指导我如何解决这个问题。

下面是代码

Sub spldel()

Dim srcLastRow As Long, destLastRow As Long
Dim srcWS As Worksheet, destWS As Worksheet
Dim i As Long, j As Long
Application.ScreenUpdating = False
Set srcWS = ThisWorkbook.Sheets("sheet1")
Set destWS = ThisWorkbook.Sheets("sheet2")
srcLastRow = srcWS.Cells(srcWS.Rows.count, "A").End(xlUp).Row
destLastRow = destWS.Cells(destWS.Rows.count, "E").End(xlUp).Row
For i = 5 To destLastRow - 1
For j = 1 To srcLastRow

' compare column E of both the sheets
If destWS.Cells(i, "E").Value = srcWS.Cells(j, "A").Value Then

destWS.Cells(i, "E").EntireRow.delete
End If
Next j
Next i
End Sub

Answer 1

当您尝试删除行时，请记住以相反的顺序循环，否则即使符合删除条件，行也可能会从删除中跳过。

所以两个For循环应该是这样的....

For i = destLastRow - 1 To 5 Step -1
For j = srcLastRow To 1 Step -1

Answer 2

这是另一种方法：

不要每次在源表和目标表中循环遍历每个项目，只需使用MATCH函数：

Function testThis()

    Dim destWS As Worksheet: Set destWS = ThisWorkbook.Worksheets("Sheet8")     ' Change to your source sheet
    Dim srcWS As Worksheet: Set srcWS = ThisWorkbook.Worksheets("Sheet12")      ' Change to your destination sheet
    Dim iLR As Long: iLR = srcWS.Range("L" & srcWS.Rows.count).End(xlUp).Row    ' Make sure you change the column to get the last row from
    Dim iC As Long
    Dim lRetVal As Long

    On Error Resume Next
    For iC = 1 To iLR
        lRetVal = Application.WorksheetFunction.Match(srcWS.Range("L" & iC), destWS.Range("A:A"), 0)
        If Err.Number = 0 Then
            destWS.Range("A" & lRetVal).EntireRow.Delete
        End If
        Err.Clear
    Next
    On Error GoTo 0

End Function

比较两张纸并删除整行

2 个答案: