循环遍历唯一数据集以返回不同工作表上的匹配值

Question

我搜索了与我所要求的内容相似的内容，但不幸的是，没有任何内容与我所要寻找的内容相近。

我在 Sheet(2) 上有一个独特的数据集： 目标是返回突出显示的蓝色列中的值，如果它与在下拉列表中选择的框匹配相同的“Item#”表（1）上的框名称。请在此处查看工作表 (1)：Sheet(1) Set-Up。

工作表 (1) 上的项目编号位于工作表 (1) 上的 B3:B12。 - 我还添加了另一个列表，我希望我的代码在其中运行在此旁边的列中是一个空白，蓝色的匹配项将发布。

我正在尝试使用 For 循环来完成此操作。我知道数据集很奇怪，但我想保持它只是为了挑战它（也因为我有一个更大的类似数据集并且只是将它用作测试运行）......我的代码是远如下：

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;宏在Sheet2 第1 行中找到Sheet1.Range("A1").Value。然后循环遍历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