Excel VBA (фильтр и видимые ячейки)

Question

Я новичок в VBA и у меня небольшой вопрос.

Ниже приведен макрос vba, который я сделал. Он отфильтрует по столбцу имен и найдет пустые ячейки, а из другого листа он найдет имена телефонных номеров и вставит их туда. Он работает нормально, но я хочу только для пустых ячеек, но этот код работает для каждой строки.

Может кто-нибудь помочь мне в изменении кода, чтобы найти значения только для видимых ячеек. (если у кого-то есть лучший вариант, я с радостью его приму) Пожалуйста, помогите

Sub namenumbers()
On Error Resume Next
rw = ActiveWorkbook.Name
MP = InputBox("Please enter Marketplace", "AU/AE/BR/CA/CN/DE/ES/FR/IT/UK/US/IN/JP/MX/SG/TR")
Dim wb As Worksheet, rng As Range
lrr = ActiveSheet.UsedRange.Rows.Count
 Set r = Range("A1").CurrentRegion
    r.AutoFilter
    BN = r.Find(what:="Numbers", after:=r(1)).Column
    Kolumn = r.Find(what:="names", after:=r(1)).Column
    r.AutoFilter Field:=Kolumn, Criteria1:="="

Workbooks.Open "C:\Macros\names with numbers.xlsx"
nw = ActiveWorkbook.Name
Workbooks(nw).Activate
Workbooks(nw).Sheets(MP).Activate
Workbooks(rw).Activate
For I = 3 To lrr
Cells(I, Kolumn) = Application.WorksheetFunction.VLookup(Cells(I, BN), Workbooks(nw).Sheets(MP).Range("B2:D1000000"), 3, 0)
Next
End Sub

Answer 1

Вы можете попробовать что-то вроде этого:

Sub namenumbers()
    Dim wb As Workbook, MP, lrr As Long, wsData As Workbook, i As Long
    Dim ws As Worksheet, rng As Range, r As Range, BN As Long, Kolumn As Long

    On Error Resume Next

    Set wb = ActiveWorkbook
    Set ws = ActiveSheet

    MP = InputBox("Please enter Marketplace", _
                  "AU/AE/BR/CA/CN/DE/ES/FR/IT/UK/US/IN/JP/MX/SG/TR")

    Set r = ws.Range("A1").CurrentRegion
    lrr = r.Rows.Count

    BN = r.Rows(1).Find(what:="Numbers", lookat:=xlWhole).Column
    Kolumn = r.Rows(1).Find(what:="names", lookat:=xlWhole).Column

    Set wsData = Workbooks.Open("C:\Macros\names with numbers.xlsx").Worksheets(MP)

    For i = 3 To lrr
        With ws.Cells(i, Kolumn)
            If Len(.Value) = 0 Then
                .Value = Application.VLookup(ws.Cells(i, BN).Value, _
                                             wsData.Range("B2:D1000000"), 3, False)
            End If
        End With
    Next

End Sub