VBA - 嵌套循环在不同的电子表格中查找列的每个值？

Question

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

我现在所拥有的并没有给我任何东西。我相信我的逻辑是正确的，但我的语法不正确？

第一次在 VBA。我正在尝试遍历第一张表“订单”以查找第二张表中 B 列中的每个值。如果该值不存在，我需要将工作表 1 中的 A 列值与工作表 3 中的相同值匹配，然后返回工作表 3 的 B 列中的值。我了解其背后的逻辑，但我不确定如何编写VBA代码。我已经发布了我在这里的内容。

感谢任何有关语法、逻辑、格式等方面的帮助

Answer 1

你快到了！您需要的是 Scripting.Dictionary。
字典以 {Key, Value} 对存储数据。引用字典的键，它会返回它的值。参考它的价值，它会给你它的关键。因为键是唯一的，所以您应该在尝试添加它们之前测试它们是否存在。
这是您要完成的工作的伪代码。

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

我更喜欢使用 For 循环而不是 For Each 循环来迭代行。
这是我的代码模式。很容易扩展。

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 

Answer 2

这是一个可能的解决方案

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

根据您的需要更改所有相关参数（工作表名称、要查找的列和要开始的行）