Объедините 2 ряда в массив и отфильтруйте

Question

У меня есть 2 диапазона, оба с одинаковым количеством строк, разным количеством столбцов (которые могут варьироваться).

Диапазон 1:

A,   1,   1,   1
B,   2,   4,   8
C,   3,   9,  27
D,   4,  16,  64

Диапазон 2:

1,       1
16,     64   
81,    
256,   1024

Я хочу импортировать эти значения в мультимассив в Excel, но только если n-й столбец (в данном случае 2-й столбец) диапазона 2 не является нулевым значением. Итак, в конце концов у меня был бы один массив, который выглядит следующим образом:

Выход 1:

A,   1,   1,   1,    1,     1
B,   2,   4,   8,   16,    32   
D,   4,  16,  64,  256,  1024

Пока - я запустил функцию:

Function Report(rng1 As Range, rng2 As Range)
Dim matrix() As Double
Dim all_rng As Range
    all_rng = Union(rng1, rng2)

End Function

Answer 1

Альтернатива массива

Просто для демонстрации четко структурированного подхода с использованием массивов вместо циклического прохождения каждой ячейки:

1. назначить данные к массивам one и two
2. добавить значения столбцов второго массива в переразмерный массив один
3. реструктурировать полученный массив путем удаления пустых строк (проверьте n-й столбец в массиве two) - через одну строку кода (с помощью вспомогательной функции)
4. запись результатов в любой целевой диапазон - через одну строку кода

Sub Report(rng1 As Range, rng2 As Range)
  ' [1a] assign data to arrays one and two
    Dim one(), two()                            ' declare variant arrays
    one = rng1.Value:  two = rng2.Value         ' results in 2-dimensioned 1-based arrays
  ' [1b] count columns in both arrays
    Dim cols1 As Long: cols1 = UBound(one, 2)
    Dim cols2 As Long: cols2 = UBound(two, 2)

  ' [2a] redimension array one (by adding the column count of array two)
    ReDim Preserve one(1 To UBound(one), 1 To cols1 + cols2)
  ' [2b] add two-values to array one
    Dim r As Long, col2 As Long                 ' declare row counter and column counter of array two
    For r = 1 To UBound(one)                    ' loop through rows (assuming same rows count in both arrays)
        For col2 = 1 To cols2                   ' loop through columns of array two
            one(r, cols1 + col2) = two(r, col2) ' ...  add all column values of array two to array one
        Next col2
    Next r

  ' [3a] get nth column of array two (for late check of empty row)
    Dim arr()
    arr = Application.Transpose(Application.Index(two, 0, cols2))  ' get "flat" 1-dim and 1-based array
  ' [3b] RESTRUCTURE via Application.Index() function (deleting empty row in nth column of array two)
    one = Application.Index(one, getRowno(arr), Application.Transpose(Evaluate("row(1:" & UBound(one, 2) & ")")))

  ' [4] write to any target range (~> e.g. CodeName Sheet2)
    Sheet2.Range("L10").Resize(UBound(one, 1), UBound(one, 2)) = one

End Sub

вспомогательная функция getRowNo()

Function getRowNo(arr) As Variant()
' Note: receives last column values of array two as 1-dim 1based array
' Purp: returns 2-dim 1-based array with non-empty row numbers of array two
    Dim i As Long, ii As Long, tmp()
    ReDim tmp(1 To 1, 1 To UBound(arr))     ' provide for temporary array
    For i = LBound(arr) To UBound(arr)
        If Len(arr(i) & "") Then            ' omit empty item
            ii = ii + 1                     ' increment temp counter
            tmp(1, ii) = i                  ' enter row number of original column data
        End If
    Next i
    ReDim Preserve tmp(1 To 1, 1 To ii)     ' correct last dimension
    getRowno = Application.Transpose(tmp)   ' return 2-dim array with rownumbers to be preserved
End Function

Answer 2

Вот возможное решение.
Примечания:
1. Я изменил Function на Sub для удобства тестирования, потому что я не могу go через функцию шаг за шагом
2. Есть несколько строк для целей тестирования (отмечены в комментариях)
3. Я предположил, что правильное количество столбцов, которые нужно заполнить rng2, находится в его первой строке
4. Есть закомментированные строки с .Select заявления - раскомментируйте его, go шаг за шагом с F8, и вы увидите, как это работает.

Ответ.

Я взял вашу матрицу так:

И получаю такой вывод, начиная с 10-й строки:

Вот код:

Sub Report() 'rng1 As Range, rng2 As Range)
Dim matrix() As Variant ' use variant if you have a mix of letters and numbers
Dim x As Long, y As Long
Dim r As Long, c As Long
Dim rows() As Long, i As Long, rowCnt As Long


' used for test purposes
Dim rng1 As Range, rng2 As Range
Set rng1 = Range(Cells(1, 1), Cells(4, 4))
Set rng2 = Range(Cells(1, 9), Cells(4, 10))


' find out columns count per each range's row 1
x = Range(rng1.Cells(1, 1), rng1.Cells(1, rng1.Columns.Count)).Columns.Count

' I assume that the correct number of columns in rng2 is in the first row
' you may change the row number if needed
y = Range(rng2.Cells(1, 1), rng2.Cells(1, rng2.Columns.Count)).Columns.Count

' check that all rows have all columns filled
For i = 0 To rng1.rows.Count - 1
    ' if all columns in rng2 are filled then add number of the row to an array of row numbers
    If Not rng2.Cells(i + 1, y) = "    " Then ' fix evaluation condition if needed - that is what was copied from post
        ReDim Preserve rows(rowCnt)
        rows(rowCnt) = i + 1
        rowCnt = rowCnt + 1
    End If
Next

i = UBound(rows) - 1

' set dimension of an matrix array
ReDim matrix(rows(i), x + y)

' start filling the matrix

' go through matrix by row
For r = LBound(rows) To UBound(rows)
        ' fill each row column by column

        'gothrough first range - it has x columns in it
        For c = 0 To x - 1
'        rng1.Cells(rows(r), c + 1).Select
            matrix(r, c) = rng1.Cells(rows(r), c + 1).Value
        Next

        ' then without changing matrix's row
        ' go through second range - it has y columns
        For c = 0 To y - 1
'        rng2.Cells(rows(r), c + 1).Select
            matrix(r, c + rows(UBound(rows))) = rng2.Cells(rows(r), c + 1).Value
        Next
Next

' print the matrix to the sheet (optional - delete when convert this back to Function)
For r = LBound(matrix) To UBound(matrix)
    For c = 0 To x + y - 1
        Cells(10 + r, c + 1) = matrix(r, c)
    Next
Next
End Sub

Если у вас есть какие-либо вопросы - оставляйте их в комментариях.