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 во втором листе. Если значение НЕ есть, мне нужно сопоставить значение столбца A в листе 1 с тем же значением в листе 3, а затем вернуть значение в столбце B листа 3. Я понимаю логику, стоящую за ней, но я не уверен, как для написания кода VBA. Я опубликовал то, что у меня есть.

Любая помощь по синтаксису, логике, формат и т.д., ценится

Answer 1

Ваш почти там! Что вам нужно - это Scripting.Dictionary.
Словарь хранит данные в {Ключ, значение} пар. Ссылка на ключ словаря, и он вернет его значение. Ссылка это значение, и это даст вам ключ. Поскольку ключи уникальны, вы должны проверить, существуют ли они, прежде чем пытаться их добавить.
Вот код Пседо для того, что вы пытаетесь выполнить.

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

Я предпочитаю использовать для перебирает для каждого цикла итерации по строкам.
Это мой код. Это очень легко расширить.

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 

изменения всех соответствующих параметров (имена листов, их столбцы для поиска в и строк, чтобы начать с) в соответствии с вашими потребностями