[英]Trying to loop through column B and if two cells in a row contain the same text then delete the first ones entire row and keep the second
Need to loop through column B and if the cell contains the text in in quotes then need to delete the entire row of the first one and keep the second.需要遍历 B 列,如果单元格包含引号中的文本,则需要删除第一行的整行并保留第二行。 Keep getting with block error
继续遇到块错误
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
As stated above, deletion during the iteration from small to bigger is wrong, as the bad variable declaration.如上所述,在从小到大的迭代过程中删除是错误的,因为变量声明错误。 You can iterate backwards, but the best solution is to not delete a row at a time .
您可以向后迭代,但最好的解决方案是一次不删除一行。 Using a
Union
range and deleting its rows at the end is the fastest way:使用
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
Apart from your definition of rng as pointed out by @Bigben you are making the classic mistake of changing a range whilst you are iterating over it.除了@Bigben 指出的 rng 定义之外,您还犯了在迭代范围时更改范围的经典错误。
When you delete a row the number of rows reduces by 1. But VBA doesn't know this so the rng variable isn't automatically adjusted.当您删除一行时,行数减少 1。但是 VBA 不知道这一点,因此不会自动调整 rng 变量。 The usual symptom is that some lines are not deleted or an index error.
通常的症状是某些行未被删除或索引错误。 To do the deletions without affecting the yet to processed remainder of the range you need to iterate backwards, from Rng to 1 step -1.
要在不影响范围内尚未处理的剩余部分的情况下进行删除,您需要向后迭代,从 Rng 到第 1 步 -1。
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
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.