Question

我需要这段代码来搜索sheet1中的表格并复制符合特定条件的行，

关于我哪里出错的任何提示？

Sub find_orders()

Application.ScreenUpdating = False

Dim r As Long, endRow As Long, pasteRowIndex As Long

endRow = Sheets("sheet1").Cells(Rows.Count, 2).End(xlUp).Row

pasteRowIndex = 2

For r = 2 To endRow
    If Cells(r, 6) = "d" Then
        Range(Cells(r, 2), Cells(r, 6)).Copy
        Sheets("sheet2").Select
        Range(Cells(pasteRowIndex, 2), Cells(pasteRowIndex, 6)).Select

        pasteRowIndex = pasteRowIndex + 1
        Sheets("sheet1").Select


        End If

Next r

End Sub

Answer 1

正如@findwindow所说，您需要限定所有范围和单元格：

Sub find_orders()

Application.ScreenUpdating = False

Dim r As Long, endRow As Long, pasteRowIndex As Long
Dim ows As ws
Dim tws As ws

Set ows = Sheets("Sheet1")
Set tws = Sheets("Sheet2")

With ows
    endRow = .Cells(Rows.Count, 2).End(xlUp).Row

    pasteRowIndex = 2

    For r = 2 To endRow
        If .Cells(r, 6) = "d" Then
            .Range(.Cells(r, 2), .Cells(r, 6)).Copy
            tws.Range(tws.Cells(pasteRowIndex, 2), tws.Cells(pasteRowIndex, 6)).PasteSpecial
            pasteRowIndex = pasteRowIndex + 1
        End If
    Next r
End With

End Sub

通过限定范围，您可以避免使用.Select命令。这使得代码变慢了。

Answer 2

尝试以下方法：

Sub find_orders()

Application.ScreenUpdating = False

Dim r As Long
Dim endRow1 As Long
Dim endRow2 As Long

endRow1 = Sheets("sheet1").Cells(Sheets("sheet1").Rows.Count, 2).End(xlUp).Row
endRow2 = Sheets("sheet2").Cells(Sheets("sheet2").Rows.Count, 2).End(xlUp).Row
endRow2 = endRow2 + 1

For r = 2 To endRow
    If Cells(r, 6) = "d" Then     'searches in column f for the letter "d" in a cell, correct?
        Range(Cells(r, 2), Cells(r, 6)).Select
        Selection.Copy
        Sheets("sheet2").Select
        Range(Cells(endrow2, 2), Cells(endrow, 6)).Select
        Selection.Paste

        Sheets("sheet1").Select

     End If
Next r

End Sub

问题是在你的代码中，pasteRowIndex总是2，就像你在if循环之前定义它一样（我有同样的问题一次）。我还在你的代码中添加了一些信息，因为特别是在VBA中非常特别总是很好;）

VBA匹配标准和粘贴

2 个答案: