VBA For Loop Data Matching using Array

VBA For Loop Data Matching using Array

Coding Module

5 лет назад

14,983 Просмотров

If I was able to help you, feel free to donate.
Paypal: [email protected]

Sub array_Match_Data()

Debug.Print Format(Now, "hh:mm:ss")

Dim rSH As Worksheet
Dim sSh As Worksheet
Set rSH = ThisWorkbook.Sheets("RAW DATA")
Set sSh = ThisWorkbook.Sheets("SEARCH DATA")

Dim rawArray() As String
Dim searchArray() As String

ReDim Preserve rawArray(1 To rSH.Range("A" & Rows.Count).End(xlUp).Row, 1 To 11)
ReDim Preserve searchArray(1 To sSh.Range("A" & Rows.Count).End(xlUp).Row, 1 To 7)

For a = 1 To rSH.Range("A" & Rows.Count).End(xlUp).Row
For b = 1 To 11
rawArray(a, b) = rSH.Cells(a, b)
Next b
Next a

For a = 1 To sSh.Range("A" & Rows.Count).End(xlUp).Row
For b = 1 To 7
searchArray(a, b) = sSh.Cells(a, b)
Next b
Next a

Dim fName As String, lName As String
For a = 2 To UBound(searchArray)
fName = searchArray(a, 1)
lName = searchArray(a, 2)

For b = 2 To UBound(rawArray)
If rawArray(b, 1) = fName And rawArray(b, 2) = lName Then

searchArray(a, 3) = rawArray(b, 4)
searchArray(a, 4) = rawArray(b, 6)
searchArray(a, 5) = rawArray(b, 7)
searchArray(a, 6) = rawArray(b, 8)
searchArray(a, 7) = rawArray(b, 10)
Exit For
End If
Next b
Next a

'Transfer data back
For a = 2 To UBound(searchArray)
For b = 3 To 7
sSh.Cells(a, b).Value = searchArray(a, b)
Next b
Next a

Debug.Print Format(Now, "hh:mm:ss")
Debug.Print "Process Completed"

End Sub

Тэги:

#Love_Coding #VBA #Excel_VBA #For_Loop_in_VBA #VBA_Array
Ссылки и html тэги не поддерживаются


Комментарии: