Блог

Часть 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" amp; SourceLastRow).Value)
                
                Dim Foreign_Key As Variant '[TargetSheet Range Store]: LAVA ID
                Foreign_Key = TargetSheet.Range("G2:G" amp; 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" amp; SourceLastRow).Value)
                    
                    Dim Primary_Field_2 As Variant '[SourceSheet Array Store]: Bayan ID
                    Primary_Field_2 = WorksheetFunction.Transpose(SourceSheet.Range("C2:C" amp; SourceLastRow).Value)
                    
                    Dim Primary_Field_3 As Variant '[SourceSheet Array Store]: Bayan ID
                    Primary_Field_3 = WorksheetFunction.Transpose(SourceSheet.Range("D2:D" amp; SourceLastRow).Value)
                    
                    Dim Primary_Field_4 As Variant '[SourceSheet Array Store]: Bayan ID
                    Primary_Field_4 = WorksheetFunction.Transpose(SourceSheet.Range("E2:E" amp; 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" amp; TargetLastRow).Value = Foreign_Field_1
                    
                    ThisWorkbook.Worksheets("Sheet2").Range("i2:i" amp; TargetLastRow).Value = Foreign_Field_2
    
                    ThisWorkbook.Worksheets("Sheet2").Range("J2:J" amp; TargetLastRow).Value = Foreign_Field_3
    
                    ThisWorkbook.Worksheets("Sheet2").Range("K2:K" amp; TargetLastRow).Value = Foreign_Field_3
    
    End Sub
 

Непроверенный, но попробуйте что-то вроде этого:

 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" amp; SourceLastRow)
    Foreign_Key = TargetSheet.Range("G2:G" amp; TargetLastRow).Value
    
    For n = 1 To NUM_DATA_COLS
        Primary_Fields(n) = SourceSheet.Range("B2:B" amp; 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 в цикле. Массивы иногда работают быстрее, но многое можно сказать и для простоты.