excel vba詞典vlookup

我的代碼需要一個多小時才能完成3500行，但我需要爲超過40000行數據工作。excel vba詞典vlookup

我正在尋找我的代碼的替代品，通過使用字典，在感興趣的上下文中提高了性能。

任何人都可以幫助我嗎？

Sub StripRow2Node() 
'Read the Strip Design table 
With Sheets("Design-Moment") 
    Sheets("Design-Moment").Activate 
    LastR1 = .Range("B" & Cells.Rows.Count).End(xlUp).Row 
    DM_arr = .Range(Cells(1, 1), Cells(LastR1, 7)) 'Col 1 to Col 7 
    DM_count = UBound(DM_arr, 1) 
End With 
'Read the x and y coordinations and thickness of a node in node design 
With Sheets("Design-Shear") 
    Sheets("Design-Shear").Activate 
    LastR2 = .Range("B" & Cells.Rows.Count).End(xlUp).Row 
    DS_arr = .Range(Cells(1, 4), Cells(LastR2, 5)) 'Col 4 to Col 5 
    SX_arr = .Range(Cells(1, 26), Cells(LastR2, 27)) 
    SY_arr = .Range(Cells(1, 30), Cells(LastR2, 31)) 
    DS_count = UBound(DS_arr, 1) 
End With 

'** Find correponding reference row in Design-Moment for nodes** 
'Match node to striip station and output row index 
For i = 5 To DS_count 
    XStrip = SX_arr(i, 1) 
    XStation = DS_arr(i, 1) 
    YStrip = SY_arr(i, 1) 
    YStation = DS_arr(i, 2) 
    For j = 5 To DM_count 
     If DM_arr(j, 1) = XStrip Then 'X-Strip Name is matched 
      If DM_arr(j, 4) >= XStation And DM_arr(j - 1, 4) < XStation Then 
       SX_arr(i, 2) = j 'matched row reference for X-strip 
      End If 
     End If 
     If DM_arr(j, 1) = YStrip Then 
      If DM_arr(j, 5) <= YStation And DM_arr(j - 1, 5) > YStation Then 
       SY_arr(i, 2) = j 
      End If 
     End If 
    Next j 
Next i 
'Write the matched strip information to node 
For i = 5 To LastR2 
    With Sheets("Design-Shear") 
     .Cells(i, 27) = SX_arr(i, 2) 
     .Cells(i, 31) = SY_arr(i, 2) 
    End With 
Next i

末次

來源

2016-07-02 vincentzack

有幾點改善：
1.使用合格的引用避免.activate報表
您與

With Sheets("Design-Shear") 
    ... 
    DS_arr = .Range(Cells(1, 4), Cells(LastR2, 5)) 'Col 4 to Col 5

很好的開始，但未能使Cells對象是指With塊。改用

With Sheets("Design-Shear") 
    ... 
    DS_arr = .Range(.Cells(1, 4), .Cells(LastR2, 5)) 'Col 4 to Col 5

現在您不必再激活工作表了。

從我不得不假定只存在一個可能的匹配在該語句返回代碼：

SX_arr(i, 2) = j

所有i;否則，第二，第三...出現將覆蓋此值j。如果情況確實如此，一旦找到匹配，您可以停止遍歷j：

SX_arr(i, 2) = j 'matched row reference for X-strip 
Exit For

快捷方式都If語句如果DM_arr(j, 1)可以匹配XStrip或YStrip。如果這些匹配是互斥的，則使用ElseIf而不是If作爲第二條語句。
快捷方式j -loop應該會顯着改善運行時間。當然，如果您需要最後匹配索引（而不是第一個），那麼這將不適用。

編輯：
對於字典的解決方案，例如見從Jeeped優秀的代碼在這裏：https://codereview.stackexchange.com/questions/133664/searching-values-of-range-x-in-range-y

來源

2016-07-02 12:35:33 user1016274

是否可以通過使用「Scripting Dictionary」重寫代碼來提高性能？ – vincentzack

很難從您的代碼中分辨出來。如果DM_arr中的值是唯一的，那麼在字典中存儲和檢查它們的存在將減少從二次到近線性的工作量。或者，不是按順序搜索，而是通過對數組進行排序並應用二進制搜索來使用數組。 – user1016274

我懷疑，幾乎所有的時間都被用於細胞通過細胞回寫到片這裏：

'Write the matched strip information to node 
For i = 5 To LastR2 
    With Sheets("Design-Shear") 
     .Cells(i, 27) = SX_arr(i, 2) 
     .Cells(i, 31) = SY_arr(i, 2) 
    End With 
Next i

回寫到Excel比從Excel讀取要慢得多。我建議關閉屏幕更新和計算，將結果（當前是X_arr（i，2）和SY_arr（i，2））累積到單獨的數組中，然後在單個操作中將數組寫回範圍，而不是單元格 - by-cell

來源

2016-07-02 15:25:17

取決於行數。實際上，可以寫完整的數組SX_arr和SY_arr，因爲它們的第一列未更改。將兩個數組轉換爲4並僅寫回Y列數組速度不會那麼快。 – user1016274

我非常贊同關閉計算。即使沒有受數據轉儲影響的公式，也會爲返回到工作表的每個值重新計算單個易失性公式。 – Jeeped

@ user1016274 - 它的40000行非常重要，但你完全可以寫回完整的SX和SY數組 - 我沒有發現它。 –

excel vba詞典vlookup

回答

相關問題