Ulangi mendeklarasikan variabel dalam array?

Nov 30 2020

Bagian I Tidak ada masalah di sini

    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
    
    

Bagian II - Sisa kode Di mana saya perlu mengulang melalui varian (untuk i = 1 hingga x) alih-alih (redupkan "variabel" sebagai varian setiap saat), saya memerlukan sintaks lengkap karena saya baru mengenal topik ini ... Anda bisa lihat di bawah.

artinya saya ingin mengulang melalui variabel itu sendiri, sehingga daripada menulis prosedur yang sama lebih dari satu kali hanya melalui prosedur yang sama.

                ' /  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

Jawaban

3 TimWilliams Dec 01 2020 at 07:10

Belum teruji tetapi coba sesuatu seperti ini:

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

Kecuali jika Anda memiliki banyak data, ini akan jauh lebih sederhana sebagai vlookup dalam satu loop. Array terkadang lebih cepat, tetapi ada banyak hal yang bisa dikatakan untuk kesederhanaan juga.