excel vba字典vlookup

Question

My code need more than one hours to complete for 3500 rows but I need to work for more than 40000 rows data.

I am looking for alternatives to my code by using dictionary, with improved performance within the context of interest.

Could anyone help me?

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

End Sub

Answer 1

There are several points to improve:
1. Use qualified references to avoid .activate statements
You start off nicely with

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

but fail to make the Cells objects refer to the With block. Instead use

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

Now you do not have to activate the sheet anymore.

2. From the code I have to assume that there is only one possible match returned in this statement:

   SX_arr(i, 2) = j

for all i ; otherwise, the second, third...occurrence would overwrite this value of j . If that is indeed the case you can stop looping over j once a match is found:

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

Shortcut both If statements if DM_arr(j, 1) can match XStrip or YStrip . If these matches are mutually exclusive, use ElseIf instead of If for the second statement.
Shortcutting the j -loop should improve the runtime noticeably. Of course, if you need the last matching index (instead of the first ) then this will not apply.

edit:
For a dictionary solution, see for instance the excellent code from Jeeped here: https://codereview.stackexchange.com/questions/133664/searching-values-of-range-x-in-range-y

Answer 2

I suspect that almost all the time is being used writing back cell-by-cell to the sheet here:

'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

Writing back to Excel is much slower than reading from Excel. I would suggest switching off screen updating and calculation, accumulating the results (currently X_arr(i, 2) and SY_arr(i, 2)) in separate arrays and then writing the arrays back to a range in a single operation rather than cell-by-cell