2016-06-14 34 views
0
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 - 嵌套循環查找不同電子表格中列的每個值?

第一次在VBA。我試圖通過第一張工作表「訂單」來查找第二張工作表B列中的每個值。如果該值不存在,則需要將表1中的列A值與表3中的相同值相匹配,然後返回表3中B列中的值。我理解其背後的邏輯,但我不確定編寫VBA代碼。我已經發布了我在這裏的內容。

任何幫助的語法,邏輯,格式等,認識

+0

將代碼放在問題而不是代碼的圖片。 – newguy

+0

你已經使用了兩個'Next xlCell'作爲一個'For'循環,這是不允許的。對於if語句,沒有'End if' – newguy

回答

0

你幾乎沒有!你需要的是一個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 
0

這裏是一個可能的解決方案

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 

改變所有相關參數(表名稱,它們列在查找和行從開始),按您的需求

+0

參見已編輯的解決方案,瞭解我可以掌握的最後解釋。但是現在您可以獲得所有信息,對搜索和返回的列進行所有可能的更改。如果您懷疑只是逐行瀏覽代碼並在即時窗口中查詢所有相關變量(例如在立即窗口中輸入「?cell.Address」或「?found.address」,然後按回車以查看是什麼當前'cell'和'found''range'變量的地址 – user3598756

+0

您是否已經嘗試編輯解決方案? – user3598756

+0

發生了什麼?-15是什麼? – user3598756