Копировать выделенные ячейки, если условие выполнено

Question

У меня есть список имен в Sheet3, Столбец A: 6-33 содержит имена некоторых клиентов. Столбец B: 6-33 пусто. Столбец C: 6-33 пусто

У меня также есть Лист 4: в столбце 5000 имен клиентов столбец C & F содержит важные данные этого клиента, которые мне нужно скопировать в столбец B & C на листе 3.

Так что, когда Sheet3.Cell Ax == Sheet4.Cell Ax Sheet3.B & C нужно скопировать данные Sheet4.C & F

Почему-то я не могу правильно понять l oop. сейчас у меня туннельное зрение, и я не могу решить эту проблему.

Answer 1

Dim clientrange As Range
Dim searchrange As Range
Dim i As Long

Set clientrange = ActiveWorkbook.Sheets(3).Range("A6") 'you may have to use sheets("sheet3")
With ActiveWorkbook.Sheets(4) 'you may have to use sheets("sheet4")
    While clientrange.Text <> ""
        'search for clients in sheet4
        For i = 1 To 5000
            If .Range("A" & i) = clientrange.Text Then
                'copy the values
                clientrange.Offset(0, 1) = .Range("C" & i)
                clientrange.Offset(0, 2) = .Range("F" & i)
                Exit For
            End If
        Next i
        'go one down
        Set clientrange = clientrange.Offset(1, 0)
    Wend
End With

Answer 2

Одним из возможных решений является функция VLOOKUP:

Лист 3

• Формула столбца B (импортируйте формулу в ячейку B6 и перетащите ее вниз):

=VLOOKUP(A6,Sheet4!$A$1:$F$5000,3,0)

• Столбец C формула (импортируйте формулу в ячейку C6 и перетащите ее вниз):

=VLOOKUP(A6,Sheet4!$A$1:$F$5000,6,0)

Код VBA:

Option Explicit

Sub tes()

     Dim ws3 As Worksheet, ws4 As Worksheet
     Dim i As Long
     Dim rngSearch As Range, rngFound As Range
     Dim arr As Variant
     Dim strValueC As String, strValueF As String

     With ThisWorkbook
        Set ws3 = .Worksheets("Sheet3")
        Set ws4 = .Worksheets("Sheet4")
     End With

     With ws3
        arr = .Range("A6:A33")
        .Range("B6:C33").Clear
     End With

     Set rngSearch = ws4.Range("A1:A5000")

     For i = LBound(arr) To UBound(arr)

        Set rngFound = rngSearch.Find(What:=arr(i, 1), LookIn:=xlValues, LookAt:=xlWhole)

        If Not rngFound Is Nothing Then

            With ws4
                strValueC = .Range("C" & rngFound.Row).Value
                strValueF = .Range("F" & rngFound.Row).Value
            End With

            With ws3
                .Range("B" & i + 5).Value = strValueC
                .Range("C" & i + 5).Value = strValueF
            End With

        End If

     Next i

End Sub