скопировать всю строку из одной матрицы в другую, используя VBA

Question

в одной части моего кода, я прочитал матрицу

Dim matr As Variant, mat As Variant, vec As Variant 
matr = Worksheets("portfolio").Range("A2:K163") 

теперь после двух if-loops я хотел бы, чтобы скопировать всю строку в новую матрицу

For i = 1 To lngRow 
    For j = 2 To ingRow 
     If matr(i, 11) = matr(j, 11) Then 
      If matr(i, 4) = matr(j, 4) Then 
       matr(j,...)=mat(j,...) 
      End If 
     End If 
    Next j 
Next i 

Как можно скопировать всю строку из существующей матрицы в другую?

Answer 1

Если я правильно понимаю ваш запрос, вот какой-то код, который должен вам помочь. Я прокомментировал это для объяснения.

Главный смысл заключается в следующем: mat динамически растет в строках, так что он может содержать новую строку данных от matr. Затем эта строка копируется.

Конечно, если вы позволите mat быть инициализирован к тому же размера, как matr и имеют много пустых строк, вы можете игнорировать всю работу с ReDim и просто использовать петлю в нижней части, чтобы скопировать строку.

Редактировать: Я отредактировал это, чтобы принять к сведению Preserve. Из документов, Preserve можно использовать только изменение последнего измерения. Поскольку это не так, данные копируются в массив temp до добавления новой строки.

Option Base 1 

Sub rr() 

    ' Initialise 2D array to a range 
    Dim matr As Variant 
    Dim rng As Range 

    Set rng = ActiveSheet.Range("A1:D7") 
    matr = rng 

    ' Range used so column count can be fetched easily 
    Dim colCount As Long 
    colCount = rng.Columns.Count 

    ' Initialise empty 2D array for populating with given rows from matr 
    Dim mat() As Variant 
    Dim matTemp() As Variant 

    ' Test conditions simplified for demo 
    Dim someCondition As Boolean 
    someCondition = True 

    ' upper bound of mat, for testing if it is dimensioned 
    Dim ub As Long 
    Dim m As Long, n As Long 
    Dim rowToCopy As Long 

    For rowToCopy = 1 To 2 

     If someCondition = True Then 

      ' test if dimensioned already 
      ub = 0 
      On Error Resume Next 
      ub = UBound(mat) 
      On Error GoTo 0 

      If ub = 0 Then 
      ' if no, dimension it to 1 row 
       ReDim mat(1, colCount) 
      Else 
      ' if yes, dimension it to 1 extra row 
       ReDim matTemp(ub + 1, colCount) 
       For m = 1 To ub 
        For n = 1 To colCount 
         matTemp(m, n) = mat(m, n) 
        Next n 
       Next m 
       ReDim mat(ub + 1, colCount) 
       mat = matTemp 
      End If 

      ' Assign 'columns' of 2D array matr to new array mat 
      For m = 1 To colCount 
       mat(ub + 1, m) = matr(rowToCopy, m) 
      Next m 

     End If 

    Next rowToCopy 

End Sub