Скопировать строку, если в именованном диапазоне присутствуют ячейки в столбце COUNTIF

Question

Очень плохо знаком с VBA, но на самом деле нужна помощь по этому коду.

Итак, я хотел бы скопировать все ячейки в столбце L в Worksheet1, если имя находится в моем именованном диапазоне (в листе Lookuptab) .

Пока у меня есть код для копирования и вставки, и он работает нормально, но с учетом критериев 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 что-либо для этот пост
2. Копирование / вставка внутри al oop может занять много времени. Попробуйте использовать 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