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} 对存储数据。引用词典的键，它将返回它的值。参考它的价值，它会给你它的关键。因为Keys是唯一的，所以在尝试添加它们之前应该测试它们是否存在。
以下是您要完成的Psuedo代码。

＆＃13;

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

＆＃13;

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

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

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

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

2 个答案: