在excel上使用vba进行无重复的Vlookup

Question

我正在尝试放置一个宏，允许我将相同的条目从一个表匹配到另一个表。棘手的部分是，如果找到匹配项，则无法重复。我对其进行理论化的方式有点初级，但鉴于我对 VBA 的了解仍然有限，这是我能想到的唯一方式。

结构

1. 需要先过滤两个表才能允许不重复条件。
2. 将搜索值存储为数组以加快宏的处理速度
3. 将要搜索的条目与目标表中的条目进行匹配，以便找到匹配项。这是通过应用程序内函数 MATCH 完成的。 MATCH 函数返回匹配所在的单元格，这很有用，因为它会不断移动范围，以免一直重复相同的值。
4. 计算移位范围后，我使用 VLookup 函数返回第二个条目。

很遗憾，宏不完整。我无法找到一种在不损害机制的情况下不断改变范围的方法。问题在于没有正确创建在每次比赛后进行移位的移位范围。

想要的结果

在下图中，期望的结果是检查左表中的所有项目是否都在右表中。拿项目A，我需要找到两个项目A。我在右栏中有一个值为 17 的第一个项目 A 和一个值为 81 的第二个项目 A。如果我没有找到任何值，我什么都没有，就像 Ds 和 E 的情况一样。如果相反，我的条目更少左表（与条目 L 的情况一样）然后我需要返回条目 L 的所有值：96； 77; 40.

    Sub Matching11()
ThisWorkbook.Activate

Worksheets.add

Worksheets("Test4").Range("A1:T110").copy Destination:=ActiveSheet.Range("A1")

With ActiveSheet

    Dim Search_Array As Variant
    Search_Array = Range("C2", Range("C1").End(xlDown)) 'use this array to loop through the value to search for


    Dim Target_MatchValue As Integer
    Dim Target_Range As Range
    Dim arr As Variant
    Dim counter As Integer
    Dim n As Integer



    counter = 0
    n = 0
    Target_MatchValue = 0

    For counter = LBound(Search_Array) To UBound(Search_Array)
        Target_MatchValue = 0

        Target_MatchValue = Application.Match(Search_Array(counter, 1), .Range("H2:H200"), 0) - 1 'change C column with the range where you will have the tyres you need search for
        Set Target_Range = .Range(.Cells(2 + n, 8), .Cells(1000, 9))  'this is supposed to work as a shifting range allowing to match entries without making repetitions. I used the MATCH function in order to set the start of the range. i.e. if there is a match in the target table the range will shift from the location of the match downwards. If the match is at on the same level then it does not shift the range in order to match the same-level entry afterwards it is supposed to shift by one unit in order to prevent repetitions.
        'If arr = Application.VLookup(Search_Array(counter, 1), Target_Range, 2, False) Is Nothing Then GoTo NextCounter    'I used Vlookup in order to return the value set in the second column of the targetted table. As alternative, I think I could just use offset since I previously used MQTCH


        arr = Application.VLookup(Search_Array(counter, 1), Target_Range, 2, False)
        If IsError(arr) Then
            GoTo NextCounter
            Else
            .Range(Cells(1 + counter, 6), Cells(1 + counter, 6)).value = arr 'Return the value of the array in this cell
        End If
        Target_Range.Select

        If Target_MatchValue = 0 Then

            n = n + 1

            ElseIf Target_MatchValue > 0 Then
            n = n + Target_MatchValue
        End If
        .Range(Cells(1 + counter, 5), Cells(1 + counter, 5)).value = Search_Array(counter, 1) 'Return the value of the array in this cell
    Next counter

NextCounter:
Next counter

End With

End Sub

Answer 1

好吧，让我们看看这是否对您有帮助，也许您可​​以根据自己的需要进行调整。

我是这样回复你的数据的：

宏将在 H 列中创建一个列表：我喜欢您图片的右侧表格。该宏将始终删除任何以前的结果。我的宏适用于 标准 范围，不适用于表格（VBA 中的 ListObjects），但您可以轻松调整它以满足您的需求。

Sub CREATE_LIST()
Application.ScreenUpdating = False
Dim LastRow As Long
Dim MyRange As Range
Dim rng As Range
Dim i As Long


'we clear previous list
Columns("H:I").Delete

'we add data
Range("H1").Value = "Target"
Range("I1").Value = "Return"

LastRow = Range("C" & Rows.Count).End(xlUp).Row 'Last row of column C, where data is.

Set MyRange = Range("D2:D" & LastRow).SpecialCells(xlCellTypeConstants, 23) 'we select only NON BLANK cells

i = 2 'initial row

For Each rng In MyRange
    Range("H" & i).Value = rng.Offset(0, -1).Value 'value of adjacent cell (Column C)
    Range("I" & i).Value = rng.Value 'value of cell in column D
    i = i + 1
Next rng

Application.ScreenUpdating = True

End Sub

执行代码后，我得到：

尝试不同的数据也可以：

希望您可以根据自己的需要进行调整。

Answer 2

对问题的解释不明确表示歉意。我在下面提供了我整理的解决方案。我正在寻找可以执行 vlookup 而不返回相同值的代码。下面是解决方案。我知道代码可能不是最干净和最优雅的代码，但它对于大数据样本来说是有效的并且运行速度足够快。

Sub Matching()

    Dim Search_Array As Variant
    Dim Target_MatchValue As Variant
    Dim Target_Range As Range
    Dim arr As Variant
    Dim counter As Integer
    Dim n As Integer

    'data must be ordered in order to apply the non-repetitive condition
    Search_Array = Sheet1.Range("A2", Sheet1.Range("A1").End(xlDown)) 'use this array to loop through the value to search for


    n = 0
    Sheet1.Activate
    With ActiveSheet
        For counter = LBound(Search_Array) To UBound(Search_Array)

            Target_MatchValue = 0
            Target_MatchValue = Application.Match(Search_Array(counter, 1), .Range(Cells(2 + n, 4), Cells(1000, 4)), 0) 'This code will return the value used for the shifting range
            Set Target_Range = .Range(Cells(2 + n, 4), Cells(1000, 5))  'this is supposed to work as a shifting range allowing to match entries without making repetitions. I used the MATCH function in order to set the start of the range. i.e. if there is a match in the target table the range will shift from the location of the match downwards. If the match is at on the same level then it does not shift the range in order to match the same-level entry afterwards it is supposed to shift by one unit in order to prevent repetitions.
            'target_range.select Activate this code in order to see the macro in action
            arr = Application.VLookup(Search_Array(counter, 1), Target_Range, 2, False) 'store the vlookup value in an array in order to increase the efficiency the code and to speed up the whole proces

                If IsError(arr) Then
                    .Cells(2 + n, 2).value = "" 'if the macro does not find anything, no value will be recorded anywhere

                    Else
                    .Cells(1 + n + Target_MatchValue, 2).value = Search_Array(counter, 2)  'Return the value of the search_array in this cell so to match column A values with column D values if they are found

                End If

                If IsError(arr) Then
                        n = n
                    ElseIf Target_MatchValue = 0 Then 'if the macro does not find anything, the shifting range does not shift so that subsequent values can be searched in the same range without missing precious matches
                        n = n + 1

                    ElseIf Target_MatchValue > 0 Then 'if there is a matching value between Column A and Column B, the shifting range shifts by the n + the distance between the the current vlookupvalue and the found value. Note that Data must be stored in a filtered order otherwise vlookup will not work correctly
                        n = n + Target_MatchValue

                End If
        Next counter

    End With

End Sub

通过与一些朋友交流想法，我被告知要考虑一个潜在的帮助列，该列将用于存储增量数字。该帮助列将存储有助于满足非重复条件的增量数字。请看下面的例子。

这里的想法是，如果在 E 列中找到一个值，我将 n 存储为等于在辅助列中找到的值。然后代码需要验证未来值的 n 是否大于之前的 n。如果满足此条件，则满足一次重复条件。 n 将值更改为下一个更大的值。 例如，如果我在右表中找到 L，我报告 96 作为值并存储 N 等于 11。当我搜索 L 的下一个值时，新的 n 必须大于当前的 n 否则我不会存储新发现的值。找到的值 77 确实比之前的值更大，因为 12 大于 11。我希望这会有所帮助。