如果满足多个条件,VBA将复制数据

Question

我正在尝试创建一个VBA代码,当第一列中的标准"Lukas"和第二列中的"Apple"符合时,它会将下表中第三列中的数据复制到Sheet"Results"中.我知道这可以通过使用具有多个条件的VLOOKUP来完成,但数据源长度通常会发生变化,我需要宏从ROW 2进行检查直到最后一个可见的ROW.

根据我的例子,我应该在运行宏后在第二张表中找到值8和5.下面是我写的代码但是没有用.

    Sub copy()

Dim LastRow As Long
Dim i As Long

LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row

For i = 2 To LastRow

If Worksheets("Sheet1").Cells(i, 1) = "Lukas" And Worksheets("Sheet1").Cells(i, 2) = “Apple” Then
 Worksheets("Sheet1").Cells(i, 3).Select
 Selection.copy
 Sheets("Sheet2").Select
 Range(Cells(1, 1)).PasteSpecial xlPasteValues

End If
Next i

End Sub

Answer 1

不要调用子程序Copy().称之为其他任何东西.

选择其他目的地,或者您只是要覆盖要传输的值.

Sub copyLukasAndApple()

    Dim LastRow As Long, i As Long, ws2 as worksheet

    with Worksheets("Sheet1")
        LastRow = .Range("A" & .Rows.Count).End(xlUp).Row

        For i = 2 To LastRow

            If .Cells(i, 1) = "Lukas" And .Cells(i, 2) = “Apple” Then
                with workSheets("Sheet2")
                    .cells(.rows.count, "A").end(xlup).offset(1, 0) = _
                         Worksheets("Sheet1").Cells(i, 3).value
                end with
            End If

        Next i
    end with

End Sub

Answer 2

这应该做的伎俩:

Sub Selectivecopy()

Dim LastRow As Long
Dim i As Long
Dim j As Long

LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row

j = 1
For i = 2 To LastRow

If Worksheets("Sheet1").Cells(i, 1) = "Lukas" And Worksheets("Sheet1").Cells(i, 2) = "Apple" Then
     Worksheets("Sheet2").Cells(j,1) = worksheets("Sheet1").Cells(i,3).Value
     j = j +1
End If
Next i

End Sub

您可以使用以下行直接设置单元格的值:Worksheets("Sheet2").Cells(j,1) = worksheets("Sheet1").Cells(i,3).Value.j每次执行此操作时,只需将值粘贴到彼此之下即可.

如果您希望在第二次运行代码时在最后一个单元格下继续此操作,则还必须j = 1使用lastrow方法替换第2页.

您也使用了大量的select和activesheets,这将是更好的避免,例如参见:如何避免在Excel中使用VBA选择,你的情况,你应该使用:Lastrow = Worksheets("sheet1").Range("A" & Rows.Count).End(xlUp).Row