VBA：在for循环中使用索引/匹配

Question

我有两列数据，我正在尝试关联这两列。 在一列中我有一个部件号，在下一栏中我有一个部件描述。 我想返回部分描述。 我写了一个for循环来完成所有内容。 我得到一个超出范围错误的下标。

Sub findDataTest()

'define and set variables
Dim i As Integer
Dim returnRange As Range
Dim lookRange As Range
Dim startCell As Range

Set startCell = Sheets("Sheet3").Range("A3:A459")

Set returnRange = Sheets("Sheet3").Range("B3:B459")

Set lookRange = Sheets("Sheets3").Range("A3:A459")

'for loop to get values
For Each startCell In lookRange

    For i = 3 To 459

        Cells(i, 6).Value = WorksheetFunction.Index(returnRange, WorksheetFunction.Match(startCell, lookRange, 0))

    Next i

Next startCell

End Sub


Part Numbers  Part Descriptions
111           nut
222           bolt
333           screw
444           flange
555           cover

以上是存储零件号和零件描述的主数据。

Part Number
111
444
222
111
333
222
222

以上是我正在使用的数据，我需要将零件描述与列出的零件编号相匹配。 我可以将零件编号的任意组合与每个零件编号显示在不同的频率。

Answer 1

你最好的选择是使用字典。 要首先执行此操作，您必须通过选中它旁边的复选框从工具/参考中添加Microsoft Scripting Runtime。

在示例中，我假设您的部件号是唯一的。 您的描述可能是重复的，但最好是唯一的，这样您也可以使用描述找到部件号。

Sheet1包含您的数据。 Sheet2显示了如何填充描述。 我在两张纸上都使用了A列和B列，但您可以根据需要更改它们。 这些数据也可以在不同的Excel文件（工作簿）上。

要轻松使用这个子你可以插入一个形状，然后右键单击它并指定一个宏，找到该子，然后你应该是好的。

附上Excel代码和示例。 你可以从这里改进代码;）

您可以从这里下载文件： https ： //ufile.io/x8n0u

Option Explicit

Sub FindDescription()
    Dim i As Long
    Dim lRow As Long
    Dim rng As Range
    Dim dict As New Dictionary
    Dim WS As Worksheet

    'Define data range
    Set WS = ThisWorkbook.Sheets("Sheet1")
    lRow = WS.Cells(WS.Rows.Count, "A").End(xlUp).Row

    'Make a dictionary [key=Part Number, item=Part Description]
    'Keys should be unique, so to avoid any error we will record only
    'the first instance in case there are part number duplicates
    On Error Resume Next 'will move on if there is any duplicate
    For i = 1 To lRow
        dict.Add WS.Cells(i, 1).Value, WS.Cells(i, 2).Value
    Next i
    On Error GoTo 0

    'Now we have the data, we need to populate the descriptions
    'find the last row in Sheet2
    Set WS = ThisWorkbook.Sheets("Sheet2")
    lRow = WS.Cells(WS.Rows.Count, "A").End(xlUp).Row

    'Clear column B regardless of finding a matching Part Desc or not
    For i = 1 To lRow
        If dict.Exists(WS.Cells(i, 1).Value) = True Then
            WS.Cells(i, 2).Value = dict(WS.Cells(i, 1).Value)
        Else
            WS.Cells(i, 2).ClearContents
        End If
    Next i

End Sub