excel - 如果命名范围 COUNTIF 中存在列中的任何单元格，则复制行

Question

对 VBA 非常陌生，但确实需要有关此代码的帮助。

因此，如果名称在我的命名范围内(在 Lookuptab 表中)，我想复制 Worksheet1 中 L 列中的任何单元格。

到目前为止，我有复制和粘贴的代码，它工作正常，但自从放入 countif标准，我得到错误 compile error sub function not defined
请帮忙!

谢谢，

我的代码如下:

a = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To a

    If CountIf(Sheets("Lookup").Range("Vendor_Lookup"), Sheets("Sheet1").Cells(i, 12).Value) > 0 Then

        Worksheets("Sheet1").Rows(i).Copy

        Worksheets("Sheet2").Activate

        b = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
        Worksheets("Sheet2").Cells(b + 1, 1).Select

        ActiveSheet.Paste

        Worksheets("Sheet1").Activate

End If

Next

Application.CutCopyMode = False


End Sub

Answer 1

CountIf不是 VBA 原生的。您必须通过访问工作表功能
Application.WorksheetFunction.CountIf(......
其他几点注意事项:

无需Activate根据 this post 的任何内容

在循环内复制/粘贴可能非常耗时。考虑使用 Union收集目标行

而不是使用 CountIf , 你可以使用 Range.Find坚持使用原生 VBA 函数

结合所有这些会产生如下内容:

Sub SHELTER_IN_PLACE()

Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Sheets("Sheet1")
Dim ws2 As Worksheet: Set ws2 = ThisWorkbook.Sheets("Sheet2")

Dim lr As Long, i As Long
Dim Target As Range, Found As Range

lr = ws1.Range("A" & ws1.Rows.Count).End(xlUp).Row

For i = 2 To lr
    Set Found = Sheets("Lookup").Range("Vendor_Lookup").Find(ws1.Range("A" & i))

        If Not Found Is Nothing Then
            If Not Target Is Nothing Then
                Set Target = Union(Target, ws1.Range("A" & i))
            Else
                Set Target = ws1.Range("A" & i)
            End If
        End If

    Set Found = Nothing
Next i

If Not Target Is Nothing Then
    lr = ws2.Range("B" & ws2.Rows.Count).End(xlUp).Offset(1).Row
    Target.EntireRow.Copy
    ws2.Range("A" & lr).PasteSpecial xlPasteValues
End If

End Sub