Question

我是VBA的新手，很惊讶没有在数组中插入元素的功能（我之前的问题）。所以我重新考虑了一下方法。

在屏幕上，我有以下示例表'allActualWeights'。我要消除很多空白（无权重值）（表格每次都不同）。因此最终结果应为“实际重量”。

在我的代码中，我尝试了以下操作：

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 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

Answer 2

这是一种方法：

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

通过跳过空白值来构建数组

2 个答案: