Vlookup沒有重復使用excel上的vba

Question

我試圖建立一個宏，允許我匹配從一個表到另一個表的相同條目。 棘手的部分是，如果找到匹配，則不能重復。 我理論化它的方式有點基礎，但鑒於我對VBA知之甚少，這是我能想到的唯一方法。

結構

1. 需要首先過濾兩個表以允許非重復條件。
2. 將搜索值存儲為數組，以加快宏的過程
3. 匹配條目以搜索目標表中的條目以查找匹配項。 這是通過應用程序內函數MATCH完成的。 MATCH函數返回匹配所在的單元格，這很有用，因為它不斷地移動范圍，以便不會一直重復相同的值。
4. 在計算了變速范圍后，我使用VLookup函數來返回第二個條目。

不幸的是，宏不完整。 我沒有辦法在不影響機制的情況下不斷改變范圍。 問題在於每次匹配后未正確創建的換檔范圍。

期望的結果

在下圖中，所需的結果是檢查左表中的所有項目是否在右表中。 拿項目A，我需要找到兩個項目As。 我在右欄中有一個值為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存儲為等於helper列中找到的值。 然后代碼需要驗證未來值n是否大於先前的n。 如果滿足該條件，則滿足一次重復條件。 n將值更改為下一個更大的值。 例如，如果我在右表中找到L，我將96報告為值並且存儲N等於11.當我搜索L的下一個值時，新n必須大於當前n否則我將不存儲新發現的價值。 找到的值77確實比前一個值大n，因為12大於11.我希望這有幫助。