我是 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))
問題可能是什么？
uj5u.com熱心網友回復：
行的絕對值到陣列
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
uj5u.com熱心網友回復：
我測驗了以下并回傳此頁面，然后從 VBasic2008 中看到了解決方案；所以我想我也會添加我的答案。
當我第一次這樣做時，我假設范圍派生陣列也是一維的。當我將陣列添加為手表并隨后能夠看到它的尺寸時，我意識到了我的錯誤。
Option Explicit
Private Sub CreateWaterfall()
'*************************************************************************
Dim i As Integer
Dim WS As Worksheet
Set WS = ThisWorkbook.Sheets("Sheet1")
'*************************************************************************
' Turn a range into an array
Dim FiguresArr As Variant
FiguresArr = WS.Range("B3", WS.Range("B3").End(xlToRight))
'*************************************************************************
' Build another array based on FiguresArr, but making all the values positive
ReDim AuxiliaryFiguresArr(0, 0) As Variant
AuxiliaryFiguresArr(0, 0) = 0
For i = 1 To UBound(FiguresArr, 2)
Call AddEntry(AuxiliaryFiguresArr, Abs(FiguresArr(1, i)))
Next i
End Sub
下面的程序由上面的代碼呼叫
Public Sub AddEntry(aList As Variant, aEntry As Variant)
'
' build array for later copy onto sheet
'
Dim i%
Dim aEntry2 As Variant
If VarType(aEntry) = vbDouble Or VarType(aEntry) = vbInteger Then
aEntry2 = Array(aEntry)
Else
aEntry2 = aEntry
End If
If aList(0, 0) <> 0 Then
ReDim Preserve aList(0 To UBound(aEntry2), 0 To UBound(aList, 2) 1)
End If
For i = 0 To UBound(aEntry2)
aList(i, UBound(aList, 2)) = aEntry2(i)
Next
End Sub
轉載請註明出處，本文鏈接：https://www.uj5u.com/houduan/504060.html
上一篇：按日期匯總大型電子表格
下一篇：從名稱范圍中獲取唯一名稱串列