Коллекция для массива, затем для диапазона

Question

У меня есть двумерная матрица в Excel, заполненная числами и нулями.Мне нужно, чтобы числа из каждой строки матрицы были перечислены без пробелов (здесь без нулей), поэтому я добавил их в коллекцию.Затем я использовал функцию, которую нашел в Stackoverlow, для преобразования коллекции в массив, который мне понадобился для записи строк обратно в Excel.Решение работает почти отлично, за исключением того, что я получаю полную строку, заполненную числами одного и того же значения, в случае, когда в матрице только 1 число.Кажется, проблема возникает во время обратной записи значений в ячейки.Во-вторых, как я могу избавиться от этих # N / D в моих результатах?Экран и код прилагаются, спасибо.

! https://imgur.com/a/aP16DE1

Option Explicit
Public Function CollectionToArray(myCol As Collection) As Variant

Dim result  As Variant
Dim cnt     As Long

ReDim result(myCol.Count - 1)

For cnt = 0 To myCol.Count - 1
result(cnt) = myCol(cnt + 1)
Next cnt

CollectionToArray = result

End Function

Public Sub TestMe()

Dim cell, k As Variant
Dim i  As Integer
Dim myCol As New Collection
Dim grKol, Destination As Range

Set grKol = Range("D4:BA4")
Set Destination = Range("D20:R20")


For i = 1 To 50
If Application.WorksheetFunction.Sum(grKol.Offset(i - 1, 0)) = 0 Then 
Exit For
For Each cell In grKol.Offset(i - 1, 0)
    If cell > 0 Then
    myCol.Add cell
    End If
Next cell
k = CollectionToArray(myCol)
Destination.Offset(i, 0) = k
Set myCol = Nothing
Next i


End Sub

Answer 1

Я не уверен, что вы делаете это наиболее эффективным способом.Цикл по коллекции выполняется намного быстрее с циклом For Each, а не по индексу, и вам, вероятно, было бы лучше записать весь вывод одним ударом.

Скелетный код для достижения вышеуказанного выглядел бы каккак это:

Dim data As Variant
Dim i As Long, j As Long, maxDim As Long
Dim rowItems As Collection, colItems As Collection
Dim output() As Variant

'Read data into an array.
data = Sheet1.Range("D4:R18").Value

'Loop through each item to populate the collections.
Set rowItems = New Collection
For i = 1 To UBound(data, 1)
    Set colItems = New Collection
    For j = 1 To UBound(data, 2)
        'Add item if it isn't a 0.
        If data(i, j) <> 0 Then colItems.Add data(i, j)
    Next
    'Add the items to the row collection if
    'it contains 1 or more items.
    If colItems.Count > 0 Then
        rowItems.Add colItems
        'Keep a note of the max number of items
        'to resize the output array.
        If colItems.Count > maxDim Then maxDim = colItems.Count
    End If
Next

'Set the output array size.
ReDim output(1 To rowItems.Count, 1 To maxDim)

'Populate the array.
i = 1
For Each colItems In rowItems
    j = 1
    For Each data In colItems
        output(i, j) = data
        j = j + 1
    Next
    i = i + 1
Next

'Write the output array to sheet.
Sheet1.Range("D21").Resize(UBound(output, 1), UBound(output, 2)).Value = output

Answer 2

Несколько предложенных изменений:

Public Sub TestMe()

    Dim cell, k As Variant
    Dim i  As Integer
    Dim myCol As New Collection
    Dim grKol, Destination As Range

    Set grKol = Range("D4:BA4")
    Set Destination = Range("D20") '<<### doesn't this get overwritten in your loop?

    For i = 1 To 50

        If Application.WorksheetFunction.Sum(grKol) > 0 Then
            For Each cell In grKol.Cells
                If cell.Value > 0 Then myCol.Add cell.Value '<< needs Value here
            Next cell

            k = CollectionToArray(myCol)
            Destination.Resize(1, UBound(k) + 1).Value = k '<< fill only needed cells
            Set myCol = New Collection
        End If

        Set grKol = grKol.Offset(1, 0)
        Set Destination = Destination.Offset(1, 0)
    Next i

End Sub