Создайте список всех значений на одном листе, которые соответствуют ячейке на другом

Question

Хорошо, мне нужно автоматически создать список на Листе 2 (в столбце А из строки 2 вниз).

Если я введу данные «Команда 1» в А1 на Листе 2, мне нужно будет вытащить любые имена из листа 1, столбец B. (В столбце A указана команда #, в которой они находятся).

Я попробовал следующее и не повезло.

= ИГРУШКА (ИНДЕКС ($ A $ 1: $ A $ 4, МАЛЕНЬКИЙ (ЕСЛИ ($ B $ 1: $ B $ 4 = $ D $ 1, ROW ($ B $ 1: $ B $ 4) -ROW ($ B) $ 1) +1), ROWS ($ B $ 1: $ B1))), "")

Ничего не произведет.

В прошлом я видел код VBA, который работал аналогично, но не мог найти его, чтобы попытаться манипулировать им, чтобы он работал в этом случае.

Answer 1

возможное решение с использованием Dictionary объекта

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address <> "$A$1" Then Exit Sub

    Dim teamRng As Range
    With Sheet1
        Set teamRng = .Range("A1", .Cells(.Rows.Count, 1).End(xlUp))
    End With

    If teamRng.Find(what:=Target.Value2, LookIn:=xlValues, lookat:=xlWhole) Is Nothing Then Exit Sub

    On Error GoTo SafeExit
    Application.EnableEvents = False

    Dim names As Variant
    Dim cel As Range
    With CreateObject("Scripting.dictionary")
        For Each cel In teamRng
            .Item(cel.Value) = .Item(cel.Value) & cel.Offset(, 1).Value & " "
        Next

        names = Split(Trim(.Item(Target.Value2)), " ")
        Sheet2.Range("A2").Resize(UBound(names) + 1).Value = Application.Transpose(names)
    End With


SafeExit:
    Application.EnableEvents = True

End Sub

Answer 2

Или используйте это в модуле кода для Sheet2 ...

    Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim vSourceSheet As Worksheet
    Dim VRow As Range
    Dim VTargetCounter As Long

    If Target.Address = "$A$1" Then
        ' clear out the names in the target column
        Range("A2:A" & Rows.Count).Clear

        ' read through Sheet1 and populate names into Sheet2
        VTargetCounter = 2
        Set vSourceSheet = ThisWorkbook.Worksheets("Sheet1")
        For Each VRow In vSourceSheet.Range("A1:A" & vSourceSheet.Range("A" & vSourceSheet.Rows.Count).End(xlUp).Row)
            If VRow.Cells(1, 1) = Target.Value2 Then
                Target.Cells(VTargetCounter, 1) = VRow.Cells(1, 2)
                VTargetCounter = VTargetCounter + 1
            End If
        Next
    End If

End Sub