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））存储在单独的数组中，然后在一次操作中将数组写回到范围内，而不是逐个存储-细胞