Question

让此代码遍历一个范围，在四列中的两列中查找行重复项。当找到匹配项时，我调整行的大小以将所有四列复制并粘贴到另一个工作表并从工作表1中删除这两行。从迭代2开始，代码在新的＆＃34;第一行＆＃34上启动两个循环;并匹配自己。问题似乎是，一旦我删除分配了＆＃34; c＆＃34;变量，必须重新初始化范围，因为下一个循环不会为c赋值。我已经尝试了下面的所有建议，但没有人解决这个问题，任何人都有任何想法？

初始数据：

LM176 | Bank-BB＆amp; T | （0.20）| 2018年2月12日

NA1119 | BB＆amp; T | 0.21 | 2018年2月14日

NA1119 | Bank-BB＆amp; T | （0.21）| 2018年2月14日

LM641 |富国银行| 0.30 | 2018年2月14日

LM6251 |富国银行| 1.00 | 2018年2月10日

LM6251 | Bank-Wells Fargo | （1.00）| 2018年2月14日

AT11 |富国银行| 2.00 | 2018年2月13日

AT11 | Bank-Wells Fargo | （2.00）| 2018年2月14日

所需数据：

LM176 | Bank-BB＆amp; T | （0.20）| 2018年2月12日

LM641 |富国银行| 0.30 | 2018年2月14日

将匹配的行复制到另一张表（工作正常）

Dim c As Range, d As Range 

Worksheets("2018 Daily Cash (Feb)").Activate

Application.ScreenUpdating = False

'Set c = Range("B2:B" & Cells(Rows.Count, "B").End(xlUp).Row)

     For Each c In Range("B2:B" & Cells(Rows.Count, "B").End(xlUp).Row)

             For Each d In Worksheets("2018 Daily Cash (Feb)").Range("B3:B" & Cells(Rows.Count, "B").End(xlUp).Row)



                  If c = d And c.Offset(0, 2).Value = d.Offset(0, 2).Value * (-1) Then

                       c.Resize(1, 4).Copy
                       Worksheets("Clears-Feb").Range("B2").End(xlDown).Offset(1, 0).PasteSpecial Paste:=xlPasteAll

                       d.Resize(1, 4).Copy
                       Worksheets("Clears-Feb").Range("B2").End(xlDown).Offset(1, 0).PasteSpecial Paste:=xlPasteAll

                       d.EntireRow.Delete
                       c.EntireRow.Delete                       

            End If               

    Next
    Next

Answer 1

您可以尝试这样的事情：

For c = 1 To Cells(Rows.Count, "B").End(xlUp).Row
         For d = c + 1 To Worksheets("2018 Daily Cash (Feb)").Range("B3:B" & Cells(Rows.Count, "B").End(xlUp).Row)



              If Cells(c, 2) = Cells(d, 2) And Cells(c, 2).Offset(0, 2).Value = Cells(d, 2).Offset(0, 2).Value * (-1) Then

                   Cells(c, 2).Resize(1, 4).Copy
                   Worksheets("Clears-Feb").Range("B2").End(xlDown).Offset(1, 0).PasteSpecial Paste:=xlPasteAll

                   Cells(d, 2).Resize(1, 4).Copy
                   Worksheets("Clears-Feb").Range("B2").End(xlDown).Offset(1, 0).PasteSpecial Paste:=xlPasteAll

                   Cells(d, 2).EntireRow.Delete
                   Cells(c, 2).EntireRow.Delete



            End If

    Next d

下一个c

Answer 2

确定。你可以改2排。对于d = c + 1 To ThisWorkbook.ActiveSheet.Cells（Rows.Count，＆＃34; B＆＃34;）。End（xlUp）.Row 而我没写：next c

Answer 3

Sub a()

For c = 1 To Cells(Rows.Count, 2).End(xlUp).Row
    For d = c + 1 To ThisWorkbook.Sheets("2018 Daily Cash (Feb)").Cells(Rows.Count, 2).End(xlUp).Row

          If Cells(c, 2) = Cells(d, 2) And Cells(c, 2).Offset(0, 2).Value = Cells(d, 2).Offset(0, 2).Value Then

               Cells(c, 2).Resize(1, 4).Copy
               Worksheets("Clears-Feb").Activate
               lr = Cells(Rows.Count, 2).End(xlUp).Row
               Cells(lr, 2).Offset(1, 0).PasteSpecial Paste:=xlPasteAll

               Cells(d, 2).Resize(1, 4).Copy
               Cells(lr, 2).Offset(1, 0).PasteSpecial Paste:=xlPasteAll

                ThisWorkbook.Sheets("2018 Daily Cash (Feb)").Activate

               Cells(d, 2).EntireRow.Delete
               Cells(c, 2).EntireRow.Delete

        End If

Next d
Next c

End Sub

Answer 4

你必须意识到使用范围会迫使你处理范围不再存在的情况！

所以，一旦你开始For Each c In...循环，你将c设置为实际范围，当你执行c.EntireRow.delete时，c范围变量消失了也可能是Next变量！

我建议你使用带有行索引的循环作为循环迭代器，以便你可以在删除任何行后轻松调整它并调整其结束条件

所以你可以试试这个（未经测试但注释过的）代码：

Dim c As Range, d As Range

Dim iRow1 As Long, iRow2 As Long
Dim copied As Boolean

With Worksheets("2018 Daily Cash (Feb)") ' reference wanted worksheet

    Application.ScreenUpdating = False

    'Set c = Range("B2:B" & Cells(Rows.Count, "B").End(xlUp).Row)
    iRow1 = 2
    Do
        Set c = .Cells(iRow1, 2)
        iRow2 = iRow1 + 1 'start searching duplicates from the row below current iRow1
        Do
            Set d = .Cells(iRow2, 2)
            If c.Value2 = d.Value2 And c.Offset(0, 2).Value2 = d.Offset(0, 2).Value2 * (-1) Then 'use Value2 to deal with plain cell content
                If Not copied Then 'if firts duplicate found
                    c.Resize(1, 4).Copy targetSht.Range("B2").End(xlDown).Offset(1, 0)  'copy/paste the current iRow1 duplicate
                    copied = True 'mark down current iRow row is to be eventually deleted
                End If

                 d.Resize(1, 4).Copy Worksheets("Clears-Feb").Range("B2").End(xlDown).Offset(1, 0) 'copy/paste the current iRow2 duplicate
                 d.EntireRow.Delete
                 iRow2 = iRow2 - 1 ' draw iRow2 back one row since you just deleted the current iRow2 and with subsequent updating it'll point to the real next row
            End If
            iRow2 = iRow2 + 1 'update current iRow2
        Loop While iRow2 <= .Cells(.Rows.Count, 2).End(xlUp).row 'loop until you reach the actual last not empty cell in column B
        If copied Then 'if any duplicates actually found...
            c.EntireRow.Delete 'then delete current iRow1 row. the next row to start with will remain the same
            copied = False ' clear the "tobe deleted" mark for iRow1 row
        Else 'otherwise
            iRow1 = iRow1 + 1 'update iRow1 row to start searching duplicates from
        End If
    Loop While iRow1 < .Cells(.Rows.Count, "B").End(xlUp).row 'loop until you reach the cell before the actual last not empty one in column B
End With

范围循环在第一次迭代后失败

4 个答案: