excel vba字典vlookup

Question

我的代碼需要3個多小時才能完成3500行，但是我需要處理40000多行數據。

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

有人可以幫我嗎？

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

結束子

Answer 1

有幾點需要改進：
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

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

2. 從代碼中，我必須假設此語句中僅返回一個可能的匹配項：

   SX_arr(i, 2) = j

對於i ; 否則，第二次，第三次...出現將覆蓋j值。 如果確實如此，則一旦找到匹配項，您就可以停止循環遍歷j ：

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

如果DM_arr(j, 1)可以匹配XStrip或YStrip DM_arr(j, 1)則兩個If語句都可以YStrip 。 如果這些匹配是互斥的，則對第二條語句使用ElseIf而不是If 。
捷徑j循環應顯着改善運行時間。 當然，如果您需要最后一個匹配的索引（而不是第一個 ），則該索引將不適用。

編輯：
對於字典解決方案，例如，請參見此處的《吉普車》中的出色代碼： https ://codereview.stackexchange.com/questions/133664/searching-values-of-range-x-in-range-y

Answer 2

我懷疑幾乎所有時間都在逐個單元地寫回這里：

'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））存儲在單獨的數組中，然后在一次操作中將數組寫回到范圍內，而不是逐個存儲-細胞