Loop che dichiara le variabili negli array?
Nov 30 2020
Parte I Nessun problema qui
Sub Get_Data_BYN()
' // Set Data Workplaces
' / Set Data WorkBooks
Dim SourceBook As Workbook
Set SourceBook = GetWorkbook(Source)
Dim TargetBook As Workbook
Set TargetBook = ThisWorkbook
' / Set Data WorkSheets
Dim SourceSheet As Worksheet
Set SourceSheet = SourceBook.Worksheets("Data")
Dim TargetSheet As Worksheet
Set TargetSheet = TargetBook.Worksheets("Sheet2")
' / Set Data Ranges
Dim SourceLastRow As Long
SourceLastRow = SourceSheet.Cells(Rows.Count, 1).End(xlUp).Row
Dim TargetLastRow As Long
TargetLastRow = TargetSheet.Cells(Rows.Count, 1).End(xlUp).Row
Dim Primary_Key As Variant '[SourceSheet Array Store]: LAVA ID
Primary_Key = WorksheetFunction.Transpose(SourceSheet.Range("A2:A" & SourceLastRow).Value)
Dim Foreign_Key As Variant '[TargetSheet Range Store]: LAVA ID
Foreign_Key = TargetSheet.Range("G2:G" & TargetLastRow).Value
Parte II - Resto del codice Dove devo scorrere le varianti (per i = 1 ax) invece di (dim "variabile" come variante ogni volta), ho bisogno della sintassi completa poiché sono nuovo in questo argomento ... tu può vedere sotto.
il che significa che voglio scorrere la variabile stessa, in modo che invece di scrivere la stessa procedura più di una volta, esegua il ciclo attraverso la stessa procedura.
' / Set Data Fields
Dim Primary_Field_1 As Variant '[SourceSheet Array Store]: Bayan ID
Primary_Field_1 = WorksheetFunction.Transpose(SourceSheet.Range("B2:B" & SourceLastRow).Value)
Dim Primary_Field_2 As Variant '[SourceSheet Array Store]: Bayan ID
Primary_Field_2 = WorksheetFunction.Transpose(SourceSheet.Range("C2:C" & SourceLastRow).Value)
Dim Primary_Field_3 As Variant '[SourceSheet Array Store]: Bayan ID
Primary_Field_3 = WorksheetFunction.Transpose(SourceSheet.Range("D2:D" & SourceLastRow).Value)
Dim Primary_Field_4 As Variant '[SourceSheet Array Store]: Bayan ID
Primary_Field_4 = WorksheetFunction.Transpose(SourceSheet.Range("E2:E" & SourceLastRow).Value)
Dim Foreign_Field_1 As Variant
ReDim Foreign_Field_1(LBound(Foreign_Key, 1) To UBound(Foreign_Key, 1), _
LBound(Foreign_Key, 2) To UBound(Foreign_Key, 2))
Dim Foreign_Field_2 As Variant
ReDim Foreign_Field_2(LBound(Foreign_Key, 1) To UBound(Foreign_Key, 1), _
LBound(Foreign_Key, 2) To UBound(Foreign_Key, 2))
Dim Foreign_Field_3 As Variant
ReDim Foreign_Field_3(LBound(Foreign_Key, 1) To UBound(Foreign_Key, 1), _
LBound(Foreign_Key, 2) To UBound(Foreign_Key, 2))
Dim Foreign_Field_4 As Variant
ReDim Foreign_Field_4(LBound(Foreign_Key, 1) To UBound(Foreign_Key, 1), _
LBound(Foreign_Key, 2) To UBound(Foreign_Key, 2))
' / Write (Keys-IndexMatch) in Array offset Foreign_Field_1
Dim i As Long
For i = LBound(Foreign_Key, 1) To UBound(Foreign_Key, 1)
Foreign_Field_1(i, 1) = Primary_Field_1( _
WorksheetFunction.Match(Foreign_Key(i, 1), Primary_Key, 0))
Foreign_Field_2(i, 1) = Primary_Field_2( _
WorksheetFunction.Match(Foreign_Key(i, 1), Primary_Key, 0))
Foreign_Field_3(i, 1) = Primary_Field_3( _
WorksheetFunction.Match(Foreign_Key(i, 1), Primary_Key, 0))
Foreign_Field_4(i, 1) = Primary_Field_4( _
WorksheetFunction.Match(Foreign_Key(i, 1), Primary_Key, 0))
Next i
' / Write (Keys-IndexMatch) in Range offset Foreign_Field_1 2
ThisWorkbook.Worksheets("Sheet2").Range("H2:H" & TargetLastRow).Value = Foreign_Field_1
ThisWorkbook.Worksheets("Sheet2").Range("i2:i" & TargetLastRow).Value = Foreign_Field_2
ThisWorkbook.Worksheets("Sheet2").Range("J2:J" & TargetLastRow).Value = Foreign_Field_3
ThisWorkbook.Worksheets("Sheet2").Range("K2:K" & TargetLastRow).Value = Foreign_Field_3
End Sub
Risposte
3 TimWilliams Dec 01 2020 at 07:10
Non testato ma prova qualcosa di simile:
Sub Get_Data_BYN()
Const NUM_DATA_COLS As Long = 4
Dim SourceSheet As Worksheet, TargetSheet As Worksheet
Dim rngPrimary_Key As Range '[SourceSheet Array Store]: LAVA ID
Dim Foreign_Key As Variant '[TargetSheet Range Store]: LAVA ID
Dim SourceLastRow As Long, TargetLastRow As Long
Dim Primary_Fields(1 To NUM_DATA_COLS), Foreign_Fields(1 To NUM_DATA_COLS), n As Long
Dim i As Long, v, m
Set SourceSheet = GetWorkbook(Source).Worksheets("Data")
Set TargetSheet = ThisWorkbook.Worksheets("Sheet2")
SourceLastRow = SourceSheet.Cells(Rows.Count, 1).End(xlUp).Row
TargetLastRow = TargetSheet.Cells(Rows.Count, 1).End(xlUp).Row
'match is much faster against a range on a sheet than against an array
Set rngPrimary_Key = SourceSheet.Range("A2:A" & SourceLastRow)
Foreign_Key = TargetSheet.Range("G2:G" & TargetLastRow).Value
For n = 1 To NUM_DATA_COLS
Primary_Fields(n) = SourceSheet.Range("B2:B" & SourceLastRow).Offset(0, n - 1).Value
Foreign_Fields(n) = EmptyCopy(Foreign_Key) 'empty array for results
Next n
' get matching rows and copy values to arrays
For i = LBound(Foreign_Key, 1) To UBound(Foreign_Key, 1)
v = Foreign_Key(i, 1)
m = Application.Match(v, rngPrimary_Key, 0)
If Not IsError(m) Then 'check got a match
For n = 1 To NUM_DATA_COLS
Foreign_Fields(n)(i, 1) = Primary_Fields(n)(m, 1)
Next n
End If
Next i
' / Write (Keys-IndexMatch) in Range offset Foreign_Field_1 2
Place2DArray TargetSheet.Range("H2"), Foreign_Fields(1)
Place2DArray TargetSheet.Range("i2"), Foreign_Fields(2)
Place2DArray TargetSheet.Range("J2"), Foreign_Fields(3)
Place2DArray TargetSheet.Range("K2"), Foreign_Fields(4)
End Sub
'return an empty array of same dimensions as 'arr'
Function EmptyCopy(arr)
Dim rv
ReDim rv(LBound(arr, 1) To UBound(arr, 1), LBound(arr, 2) To UBound(arr, 2))
EmptyCopy = rv
End Function
'copy a 1-based 2-d array 'arr' to a worksheet, starting at cell 'c'
Sub Place2DArray(c As Range, arr)
c.Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
End Sub
A meno che tu non abbia molti dati, però, questo sarebbe molto più semplice come una visualizzazione in un ciclo. Gli array a volte sono più veloci, ma c'è molto da dire anche sulla semplicità.