Создание массива путем пропуска пустых значений

Question

Я новичок в VBA и был удивлен, что нет функции для вставки элементов в массив (мой предыдущий вопрос). Поэтому я немного переосмыслил свой подход.

На экране у меня есть пример таблицы «allActualWeights». Есть много пробелов (без значения веса), от которых я хочу избавиться (таблица меняется каждый раз). Таким образом, конечный результат должен быть «actualWeights».

В своем коде я пробовал следующее:

Option Base 1
Dim allActualWeights
allActualWeights = Range("A6:E29").Value
Dim actualWeights
actualWeights = allActualWeights

For Index = 1 To 24
    If allActualWeights(Index, 2) <> 0 Then
        ReDim actualWeights(Index, 5)
        actualWeights(Index, 1) = allActualWeights(Index, 1)
        actualWeights(Index, 2) = allActualWeights(Index, 2)
        actualWeights(Index, 3) = allActualWeights(Index, 3)
        actualWeights(Index, 4) = allActualWeights(Index, 4)
        actualWeights(Index, 5) = allActualWeights(Index, 5)
    End If
Next Index

Range("G6:K29") = actualWeights

Но я не получаю результаты, на которые надеялся. Что я делаю не так или есть лучший подход?

Answer 1

Вот один подход:

Sub Tester()

    Dim allActualWeights, actualweights(), i As Long, n As Long, c As Long
    Dim rngSource As Range

    Set rngSource = ActiveSheet.Range("A6:E29")

    With rngSource
        allActualWeights = .Value
        'size the output array # of rows to count of values in ColB
        ReDim actualweights(1 To Application.CountA(.Columns(1)), _
                            1 To .Columns.Count)
    End With

    n = 1
    For i = LBound(allActualWeights, 1) To UBound(allActualWeights, 1)
        If Len(allActualWeights(i, 2)) > 0 Then
            For c = LBound(allActualWeights, 2) To UBound(allActualWeights, 2)
                actualweights(n, c) = allActualWeights(i, c)
            Next c
            n = n + 1  'next output row
        End If
    Next i

    'put the array on the sheet
    Range("G6").Resize(UBound(actualweights, 1), UBound(actualweights, 2)) = actualweights

End Sub

Answer 2

Это должно сделать это и легко обслуживаемо ...

Sub ActualWeights()

    Dim c&, i&, j&, n&, a, b

    With [a6:e29] '<-- allActualWeights 

        a = .Value2
        n = UBound(a) - Application.CountBlank(.Offset(, 1).Resize(, 1))
        ReDim b(1 To n, 1 To UBound(a, 2))

        For i = 1 To UBound(a)
            If a(i, 2) Then
                c = c + 1
                For j = 1 To UBound(a, 2)
                    b(c, j) = a(i, j)
                Next
            End If
        Next

        .Offset(, 6).Resize(n) = b

    End With

End Sub