배열에서 변수를 선언하는 루프?

Question

파트 I 여기서 문제 없습니다

    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
    
    

파트 II-나머지 코드 (매번 변형으로 희미한 "변수") 대신 변형 (i = 1에서 x까지)을 반복해야하는 경우이 주제를 처음 접할 때 전체 구문이 필요합니다. 아래에서 볼 수 있습니다.

즉, 변수 자체를 반복하여 동일한 프로 시저를 두 번 이상 작성하는 대신 동일한 프로 시저를 반복합니다.

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

Answer 1

테스트되지 않았지만 다음과 같이 시도하십시오.

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

그래도 많은 데이터가 없다면 루프의 vlookup보다 훨씬 간단합니다. 배열은 때로 더 빠르지 만 단순함을 위해 할 말이 많습니다.