尝试遍历 B 列，如果一行中的两个单元格包含相同的文本，则删除第一个整行并保留第二个

Question

需要遍历 B 列，如果单元格包含引号中的文本，则需要删除第一行的整行并保留第二行。 继续遇到块错误

Dim i As Long
Dim rng As Range


rng = Sheets("Sheet1").Range("B" & Rows.Count).End(xlUp).Row

For i = 1 To rng

If Cells(i, 1).Value = "FINANCE SYSTEM OF GREEN BAY, INC." And Cells(i, 1).Offset(1, 0).Value = "FINANCE SYSTEM OF GREEN BAY, INC." Then
Cells(i, 1).EntireRow.Delete

End If

Next i

Answer 1

如上所述，在从小到大的迭代过程中删除是错误的，因为变量声明错误。 您可以向后迭代，但最好的解决方案是一次不删除一行。 使用Union范围并在末尾删除其行是最快的方法：

Sub deleteRowsAtOnce()
   Dim sh As Worksheet, i As Long, lastRow As Long, rngDel As Range

  Set sh = Sheets("Sheet1")
  lastRow = sh.Range("B" & sh.rows.count).End(xlUp).row

 For i = 1 To lastRow
     If sh.cells(i, 1).value = "FINANCE SYSTEM OF GREEN BAY, INC." And _
            sh.cells(i, 1).Offset(1, 0).value = "FINANCE SYSTEM OF GREEN BAY, INC." Then
        If rngDel Is Nothing Then
            Set rngDel = sh.cells(i, 1)
        Else
            Set rngDel = Union(rngDel, sh.cells(i, 1))
        End If
    End If
 Next i
 If Not rngDel Is Nothing Then rngDel.EntireRow.Delete
End Sub

Answer 2

除了@Bigben 指出的 rng 定义之外，您还犯了在迭代范围时更改范围的经典错误。

当您删除一行时，行数减少 1。但是 VBA 不知道这一点，因此不会自动调整 rng 变量。 通常的症状是某些行未被删除或索引错误。 要在不影响范围内尚未处理的剩余部分的情况下进行删除，您需要向后迭代，从 Rng 到第 1 步 -1。

Answer 3

删除行（反向循环）

Option Explicit

Sub KeepTheSecond()
    
    Const wsName As String = "Sheet1"
    Const Col As String = "B"
    Const CritString As String = "FINANCE SYSTEM OF GREEN BAY, INC."

    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    Dim ws As Worksheet: Set ws = wb.Worksheets(wsName)
    Dim LastRow As Long: LastRow = ws.Range(Col & ws.Rows.Count).End(xlUp).Row

    Dim r As Long
    
    For r = LastRow - 1 To 1 Step -1
        If StrComp(ws.Cells(r, Col).Value, CritString, vbTextCompare) = 0 Then
            If StrComp(ws.Cells(r, Col).Offset(1).Value, CritString, _
                    vbTextCompare) = 0 Then
                ws.Cells(r, Col).EntireRow.Delete
            End If
        End If
    Next r

End Sub