复制行，如果列中的任何单元格存在于命名范围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(......

---

另外一些注意事项：

1. [Activate不需要this post任何内容
2. 在循环内复制/粘贴可能很耗时。考虑使用Union收集目标行
3. 代替使用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