VBA Jagged Array для диапазона

Мой макрос проходит через диапазон, просматривая столбцы, находит, где числовые данные начинаются в каждом столбце, и сохраняет диапазоны в зубчатом массиве (вариант "матрицы" в коде).

После этого я хотел бы вернуть всю матрицу в диапазон на другом листе. Если я пытаюсь присвоить "matrix(1)" диапазон, в который я хочу поместить его, он работает нормально, но если я пытаюсь назначить весь "matrix" диапазону, я получаю пустые ячейки.

Как я могу вернуть все значения в "матрице" в диапазон сразу, без использования циклов?

Это исходные данные, через которые проходит цикл:

Я хотел бы, чтобы все строки "матрицы" были возвращены как это:

Вот мой код:

       Sub MyMatrix()

        Dim wb1 As Workbook
        Set wb1 = ActiveWorkbook

        Dim wsNSA As Worksheet
        Set wsNSA = wb1.Worksheets("NSA")

        Dim wsSA As Worksheet
        Set wsSA = wb1.Worksheets("SA")

        Dim col As Range

        Dim matrix() As Variant


        'LR is the Last row and LC is the last column with data
        LR = wsNSA.Cells(1, 1).End(xlDown).Row
        LC = wsNSA.Cells(LR, 1).End(xlToRight).Column

        'Loops through columns and finds the row where numeric data begins
        For Each col In wsNSA.Range(wsNSA.Cells(1, 2), wsNSA.Cells(LR, LC)).Columns
        wsNSA.Activate
        nsa = wsNSA.Range(wsNSA.Cells(1, col.Column), wsNSA.Cells(LR, col.Column))

        num_linha = Application.Match(True, Application.Index(Application.IsNumber(nsa), 0), 0)
        nsa = wsNSA.Range(wsNSA.Cells(num_linha, col.Column), wsNSA.Cells(LR, col.Column))

    'The range starts in the column B in the worksheet, so the matrix ubound is 'col.column -1
        ReDim Preserve matrix(1 To col.Column - 1)
         matrix(col.Column - 1) = nsa

        Next

        wsSA.Range(wsSA.Cells(3, 2), wsSA.Cells(LR, LC)) = matrix


        End Sub

2 ответа

Вы можете просто скопировать все и удалить пустые ячейки после:

Sheet1.Range("A3").CurrentRegion.Copy Destination:= Sheet2.Range("A3")

Sheet2.Range("A3").CurrentRegion.SpecialCells(xlCellTypeBlanks).Delete xlShiftUp

Если вы хотите забыть о том, что вывод не должен быть записан внутри цикла, следующий код, вероятно, сделает то, что вы пытаетесь сделать:

Sub MyMatrix()

    Dim wb1 As Workbook
    Set wb1 = ActiveWorkbook

    Dim wsNSA As Worksheet
    Set wsNSA = wb1.Worksheets("NSA")

    Dim wsSA As Worksheet
    Set wsSA = wb1.Worksheets("SA")

    Dim c As Long
    Dim LC As Long
    Dim LR As Long
    Dim num_linha As Long
    Dim nsa As Variant

    With wsNSA
        'LR is the Last row and LC is the last column with data
        '???? Is data1_linha declared anywhere and assigned a value? ????
        LR = .Cells(data1_linha, 1).End(xlDown).Row
        LC = .Cells(LR, 1).End(xlToRight).Column

        'Loops through columns and finds the row where numeric data begins
        For c = 2 To LC
            nsa = .Range(.Cells(1, c), .Cells(LR, c))
            num_linha = Application.Match(True, Application.Index(Application.IsNumber(nsa), 0), 0)
            wsSA.Cells(3, c).Resize(LR - num_linha + 1, 1).Value = .Range(.Cells(num_linha, c), .Cells(LR, c)).Value
        Next
    End With

End Sub
Другие вопросы по тегам