Циклический просмотр уникального набора данных для возврата совпадающего значения на другой лист

Question

Я искал что-то похожее на то, что я спрашиваю, и, к сожалению, нет ничего похожего на то, что я ищу.

У меня есть уникальный набор данных здесь на листе (2): Цель состоит в том, чтобы вернуть значения в выделенных синих столбцах, если они совпадают с «Элементом №» для поля, выбранного в раскрывающемся списке имен блоков на листе (1).Смотрите лист (1) здесь: Лист (1) Настройка .

Пункт № на листе (1) находится в B3: B12 на листе (1).- Я также добавил еще один список, в котором я хотел бы, чтобы мой код выполнялся В столбце рядом с этим есть пробел, где будут размещены соответствующие элементы в синем цвете.

Я пытаюсьДля этого используйте For Loops.Я понимаю, что набор данных странный, но я хочу сохранить его таким, чтобы его можно было просто решить (а также потому, что у меня похожий набор данных большего размера, и я просто использую его в качестве тестового прогона) ... Мой код такЭто так:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim KeyCells As Range
' In order to run code on sheet without a button or enabling in a module
Set KeyCells = Range("A1")

If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then

Dim i, j As Long
Dim n As Long
Dim box As String
Set sh2 = ThisWorkbook.Sheets(2)
Set rn2 = sh2.UsedRange

box = Sheets(1).Cells.Range("A1")

Dim k1 As Long
k1 = rn2.Rows.Count + rn2.Row - 1

n = 0

For i = 1 To k1
If Sheets(2).Cells(1, i) = box Then
    If n = 0 Then
        Sheets(1).Cells(3, 3).Value = Sheets(2).Cells(i, 2)
        n = n + 1
    End If

    ElseIf n > 0 Then

        For j = 3 To n + 2
            If Sheets(2).Cells(2, i).Value = Sheets(1).Cells(j, 2).Value Then

                If Sheets(2).Cells(2, i).Value <> Sheets(1).Cells(j, 2).Value Then
                x = x
                Else
                x = x + 1
                End If
            End If
        Next

    If x = 0 Then
    Sheets(1).Cells(3 + n, 3).Value = Sheets(2).Cells(2, i).Value
    n = n + 1
    End If
End If

x = 0

Next


End If
End Sub

Пожалуйста, дайте мне знать, что вы, эксперты, думаете!

Answer 1

Редактировать 2;макрос находит Sheet1.Range("A1").Value в Sheet2 строке 1. Затем он проходит по каждой ячейке ниже найденного значения в Sheet2.Затем он находит значение каждой ячейки в Sheet1.Затем он скопирует значение ячейки в Sheet2 из следующей ячейки справа и поместит значение в ячейку в Sheet1 в следующую ячейку справа.Затем он возвращается к следующей ячейке в sheet2, выполняет ту же задачу и т. Д.

Private Sub Worksheet_Change(ByVal target As Range) 'Works
Dim fndTrgt As Range, fndCel As Range

    If target.Address = "$A$1" Then
        Set fndTrgt = Sheets("Sheet2").Rows(1).Find(target.Value)

        If Not fndTrgt Is Nothing Then
            For i = 1 To 5
                Set fndCel = Sheets("Sheet1").Range("A2:D12").Find(fndTrgt.Offset(i).Value)
                If Not fndCel Is Nothing Then
                    fndCel.Offset(, 1).Value = fndTrgt.Offset(i, 1).Value
                End If
            Next i
        End If
    End If

End Sub