Question

我在这里尝试使用代码来匹配Sheet1和Sheet3中“ M”列的所有单元格，并复制和删除Sheet1中包含Sheet3的“ M”列中任何值的所有行。另外，我希望将记录复制到“ Sheet2”中（要删除的所有记录）。但是，它正在删除所有记录，但仅复制第一行，而不是所有必需的行。我尝试了一些在网上找到的解决方案，但是没有运气。任何人都可以提出问题的答案。

下面是代码：

Sub DeleteRows()

Dim rng As Range
Dim r As Long
Dim lr1 As Long
Dim lr3 As Long
Dim str As Variant
Dim i As Long: i = 1

Application.ScreenUpdating = False


lr3 = Sheets("Sheet3").Cells(Rows.Count, "M").End(xlUp).Row

Set rng = Sheets("Sheet3").Range("M2:M" & lr3)


lr1 = Sheets("Sheet1").Cells(Rows.Count, "M").End(xlUp).Row

For r = lr1 To 2 Step -1

    str = Sheets("Sheet1").Cells(r, "M")

    If Application.WorksheetFunction.CountIf(rng, str) > 0 Then

         Sheets("Sheet1").Range(Cells(r, "A"), Cells(r, "N")).Cut Sheets("Sheet2").Cells(i, "A")
         Sheets("Sheet1").Range(Cells(r, "A"), Cells(r, "N")).Delete (xlShiftUp)
         i = i + 1
         End If
Next r

Application.ScreenUpdating = True

End Sub

感谢您的帮助！预先感谢！

Answer 1

下面是您添加With块和.的几乎完全相同的代码，因为这可能是问题所在

Sub DeleteRows()

    Dim rng As Range
    Dim r As Long
    Dim lr1 As Long
    Dim lr3 As Long
    Dim str As Variant
    Dim i As Long: i = 1

    Application.ScreenUpdating = False
    With ThisWorkbook.Worksheets("Sheet3")
        lr3 = .Cells(.Rows.Count, "M").End(xlUp).Row
        Set rng = .Range("M2:M" & lr3)
    End With

    With ThisWorkbook.Worksheets("Sheet1")
        lr1 = .Cells(.Rows.Count, "M").End(xlUp).Row
        For r = lr1 To 2 Step -1
            str = .Cells(r, "M").Value
            If Application.WorksheetFunction.CountIf(rng, str) > 0 Then
                Sheets("Sheet2").Range(Sheets("Sheet2").Cells(i, "A"), Sheets("Sheet2").Cells(i, "N")).Value = _ 
                    .Range(.Cells(r, "A"), .Cells(r, "N")).Value
                .Range(.Cells(r, "A"), .Cells(r, "N")).Delete (xlShiftUp)
                i = i + 1
            End If
        Next r
    End With

    Application.ScreenUpdating = True
End Sub

VBA剪切粘贴仅复制一行，而不是复制所有行

1 个答案: