excel - 通过循环将一个动态数组的值分配给另一个有变化的动态数组(VBA)

Question

我是 VBA 编程语言的新手，所以我需要一些帮助。

我正在尝试使用 VBA 在 Excel 中自动构建瀑布图。通常我都是手动完成所有操作的，而且当数据发生变化时通常会花费很长时间。所以我决定使用 VBA 来加速这个过程。

要创建瀑布图，我需要创建额外的数据系列。我正在尝试通过使用数组和循环来做到这一点。

首先，我需要创建一个由初始数组(范围)的绝对值组成的数组。但是我遇到了一个错误“下标超出范围”并且无法弄清楚问题是什么。我想，在我更了解的 Python 中，不会有这样的问题。

这是我的代码:

 Sub CreateWaterfall()
'*************************************************************************
    Dim i As Integer
'*************************************************************************
' Turn a range into an array
    Dim FigureArrayLength As Integer
    FigureArrayLength = Range("B3", Range("B3").End(xlToRight)).Count
    
    Dim FiguresArr() As Variant
    ReDim FiguresArr(FigureArrayLength)
    FiguresArr = Range("B3", Range("B3").End(xlToRight))
'*************************************************************************
' Build another array based on FiguresArr, but making all the values positive
    Dim AuxiliaryFiguresArr() As Variant
    ReDim AuxiliaryFiguresArr(FigureArrayLength)
    
    For i = 1 To FigureArrayLength
        AuxiliaryFiguresArr(i) = Abs(FiguresArr(i))
    Next i
    
End Sub

Excel 不喜欢的是这一行，当我按下“调试”按钮时，它会以黄色突出显示:

AuxiliaryFiguresArr(i) = Abs(FiguresArr(i))

可能是什么问题？

Answer 1

行的绝对值到数组

Sub ArrAbsRowTEST()
    
    ' Reference the worksheet ('ws').
    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
    
    ' Reference the one-row range ('rrg') (a pretty risky way).
    Dim rrg As Range: Set rrg = ws.Range("B3", ws.Range("B3").End(xlToRight))
        
    ' Using the 'ArrAbsRow' function (on the range),
    ' write the converted values to an array ('Arr').
    Dim Arr() As Variant: Arr = ArrAbsRow(rrg)
    
    ' Continue, e.g.:
    Debug.Print "The array contains the following numbers:"
    Debug.Print Join(Arr, vbLf)
    
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      Returns the absolute values of the values from the first row
'               of a range ('rrg') in a 1D one-based array.
' Remarks:      It is assumed that the first row of the range
'               contains numbers only.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function ArrAbsRow( _
    ByVal rrg As Range) _
As Variant
    
    ' Write the values from the first row of the range
    ' to a 2D one-based one-row array ('rData').
    
    Dim rData() As Variant
    Dim cCount As Long
    
    With rrg.Rows(1)
        cCount = .Columns.Count
        If cCount = 1 Then ' one cell
            ReDim rData(1 To 1, 1 To 1): rData(1, 1) = .Value
        Else ' multiple cells
            rData = .Value
        End If
    End With
    
    ' Write the absolute values of the values from the 2D array
    ' to the resulting 1D one-based array ('Arr').
    
    Dim Arr() As Variant: ReDim Arr(1 To cCount)
    
    Dim c As Long
    
    For c = 1 To cCount
        Arr(c) = Abs(rData(1, c))
    Next c
    
    ' Assign the 1D array to the result.
    
    ArrAbsRow = Arr
    
End Function