VBA - nested loop to find each value of a column in a different spreadsheet?

问题

Sub Search2 () 
Dim endRowsl As Long
endRowsl = Sheets ("Orders").Cells.Rows.Count, "A").End(xlUp).Row 
Dim countRows4 As Integer
countRows4 = 4
Dim x1Range As Range
Dim xlCell As Range
Dim xlSheet As Worksheet
Dim keyword As String
Set xlSheet = Worksheets ("Tag50")
Set x1Range = xlSheet.Range ("Al :A5") 

For j = 2 To endRowsl
keyword = Sheets("Order").Range("B" & j ).Value 
For Each xlCell In x1Range
    If xlCell.Value = keyword Then 
        Next xlCell 
    ElseIf Not xlCell.Value = keyword Then
        Sheets ("Test").Rows(countRows4).Value = Sheets("Order").Rows(j).Value
        countRows4 = countRows4 + 1
        Next xlCell 
    End If 
Next  
End Sub

What I have right now that is not giving me anything. I believe my logic is correct, but my syntax is not?

First time at VBA. I am trying to loop through the first sheet 'orders' to find each value in column B in the second sheet. If the value is NOT there, I need to match the column A value in sheet 1 to the same value in sheet 3, then return the value in column B of sheet 3. I understand the logic behind it, but I am not sure how to write the VBA code. I have posted what I have here.

Any help on syntax, logic, format, etc., is appreciated

回答1:

Your almost there! What you need is a Scripting.Dictionary.
Dictionary store data in {Key, Value} pairs. Reference a Dictionary's Key and it'll return it's value. Reference it's value and it'll give you it's key. Because Keys are unique you should test if they exist before you try and add them.
Here is the Psuedo Code for what you are trying to accomplish.

Sub Search2()
    Dim keyword As String, keyvalue As Variant
    Dim dicOrders
    Set dicOrders = CreateObject("scripting.dictionary")

    With Worksheets("orders")
        Begin Loop
        keyword = .Cells(x, 1)
        keyvalue = .Cells(x, 1)
        'Add Key Value pairs to Dictionary
        If Not dicOrders.Exists(keyword) Then dicOrders.Add keyword, keyvalue
        End Loop
    End With

    With Worksheets("tag50")
        Begin Loop
        keyword = .Cells(x, 1)
        'If keyword exist remove Key from Dictionary
        If dicOrders.Exists(keyword) Then dicOrders.Remove keyword
        End Loop
    End With
   ' Now dicOrders only has unmatched orders in it
    With Worksheets("Test")
        Begin Loop
            keyword = .Cells(x, 1)
        'If keyword exist write keyvalue to Column B
        If dicOrders.Exists(keyword) Then .Cells(x, 2) = dicOrders(keyword)
        End Loop
    End With

End Sub

I prefer to use For Loops over For Each loop to iterate over rows.
This is my code pattern. It's very easy to expand.

With Worksheets("Test")
    For x = 2 To lastRow
        Data1 = .Cells(x, 1)
        Data2 = .Cells(x, 2)
        Data3 = .Cells(x, 3)
        Data5 = .Cells(x, 5)
    Next
End With 

回答2:

here's a possible solution

Option Explicit

Sub main()
    Dim orderRng As Range, tag50Rng As Range, sheet3Rng As Range, testRng As Range
    Dim cell As Range, found As Range
    Dim testRowsOffset As Long

    Set orderRng = GetRange("orders", "B", 2) '<--| set sheet "order" column "B" cells from row 2 down to last non empty one as range to seek values of in other ranges
    Set tag50Rng = GetRange("tag50", "A") '<--| set sheet "tag50" column "A" cells from row 1 down to last non empty one as range where to do 1st lookup in
    Set sheet3Rng = GetRange("sheet3", "A") '<--| set sheet "sheet3" column "A" cells from row 1 down to last non empty one as range where to do 2nd lookup in
    Set testRng = Worksheets("test").Range("A4") '<--| set sheet "test" cell "A4" as range where to start returning values from downwards

    For Each cell In orderRng '<--| loop through each cell of "order" sheet column "B"
        Set found = tag50Rng.Find(what:=cell.Value, lookat:=xlWhole, LookIn:=xlValues) '<--| lookup for current cell value in "tag50" column "A"

        If found Is Nothing Then '<--| if no match found
            Set found = sheet3Rng.Find(what:=cell.Offset(, -1).Value, lookat:=xlWhole, LookIn:=xlValues) '<--| lookup for current cell offsetted 1 column left value in "sheet3" column "A"
            If Not found Is Nothing Then '<--| if match found
                testRng.Offset(testRowsOffset) = found.Offset(, 1).Value '<--| return sheet3 found cell offsetted 1 column right value
                testRowsOffset = testRowsOffset + 1 '<--| update row offset counter from "test" cell A4
            End If
        End If
    Next cell
End Sub


Function GetRange(shtName As String, col As String, Optional firstRow As Variant) As Range
    ' returns the range of the passed worksheet in the passed column from passed row to last non empty one
    ' if no row is passed, it starts from row 1

    If IsMissing(firstRow) Then firstRow = 1
    With Worksheets(shtName)
        Set GetRange = .Range(.Cells(1, col), .Cells(.Rows.Count, col).End(xlUp))
    End With
End Function

change all relevant parameters (sheet names, their columns to lookup in and rows to start from) as per your needs

来源：https://stackoverflow.com/questions/37802716/vba-nested-loop-to-find-each-value-of-a-column-in-a-different-spreadsheet