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で初めて。最初のシート 'orders'をループして、2番目のシートの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 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 

変更、関連するすべてのパラメータ（から開始するシート名、ルックアップするために彼らの列と行）は、ニーズ