PDA

View Full Version : Excel vba - Match Data



vincentzack
07-02-2016, 05:34 AM
My code need more than one hours to complete for 3500 rows data 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

mdmackillop
07-02-2016, 06:09 AM
Welcome to VBAX
Can you post a sample file? Use Go Advanced/Manage Attachments

Paul_Hossler
07-02-2016, 06:18 AM
Also with a sample of the 'After' also please

vincentzack
07-02-2016, 06:47 AM
Attached excel file after run the code.

Is is possible to speed up by rewriting the code with using "Scripting Dictionary"?

Thank you very much!

snb
07-02-2016, 07:14 AM
Also with a sample of the 'After' also please

What after ? Morning after ?? ;)

mdmackillop
07-02-2016, 07:28 AM
Your sample does not appear to return any valid data. Writing the results though could do without the loop

With Sheets("Design-Shear")
.Cells(5, 27).Resize(lastr2, 2) = SX_arr
.Cells(5, 31).Resize(lastr2, 2) = Sy_arr
End With

snb
07-02-2016, 07:32 AM
@vincent can you describe in words what should happen when the first 'record' in the sheet 'design-moment' has been read ?

Which elements of the record will be used to search for in the other sheet ?
Where will these elements be searched in in the other sheet ?
Which elements in the other sheet have to be adapted and by what data ?

SamT
07-02-2016, 07:49 AM
This compiles. Obviously I have no way to test it.

Sub StripRow2Node()

'Read the Strip Design table
With Sheets("Design-Moment")
DM_arr = .Range(Cells(1, 1), Cells(.Rows.Count, "B").End(xlUp).Offset(, 4)) 'Col 1 to Col 5
End With

'Read the x and y coordinations and thickness of a node in node design
With Sheets("Design-Shear")
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("Z1:Z" & LastR2)
SY_arr = .Range("AD1:AD" & LastR2)
End With
ReDim XRow_arr(UBound(SX_arr))
ReDim YRow_arr(UBound(SY_arr))

'** Find correponding reference row in Design-Moment for nodes**

'Match node to striip station and output row index
For i = 5 To UBound(DS_arr, 1)
YStrip = SY_arr(i)

FoundX = 0: FoundY = 0
For j = 5 To UBound(DM_arr, 1)
If DM_arr(j, 1) = SX_arr(i) Then '
If DM_arr(j, 4) >= DM_arr(j - 1, 4) And DM_arr(j - 1, 4) < XStation Then
XRow_arr(i) = j 'matched row reference for X-strip
End If
End If

If DM_arr(j, 1) = SY_arr(i) Then
If DM_arr(j, 5) <= DM_arr(j - 1, 5) And DM_arr(j - 1, 5) > DS_arr(i, 2) Then
YRow_arr(i) = j
End If
End If

If XRow_arr(i) * YRow_arr(i) Then Exit For 'Unassigned = 0 = False
Next j
Next i

'Write the matched strip information to node
Application.ScreenUpdating = False
With Sheets("Design-Shear")
Tmp_arr = .Range("AA1:AA4")
.Range("AA1").Resize(UBound(XRow_arr)) = XRow_arr
.Range("AA1:AA4") = Tmp_arr

Tmp_arr = .Range("AE1:AE4")
.Range("AE1").Resize(UBound(YRow_arr)) = YRow_arr
.Range("AE1:AE4") = Tmp_arr
End With
Application.ScreenUpdating = True
End Sub



Edit: Oooooops. I shrank one array too far.

Paul_Hossler
07-02-2016, 02:54 PM
What after ? Morning after ?? ;)

:giggle

:thumb