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à.