我有一个数组，其中维度数和每个维度的计数是未知的。我正在努力使一个功能，可以写出在一个标准化的一维/扁平/融化格式的数据。我遇到了一些问题:
- 它没有按照我期望的顺序在我的数组上迭代，
- 不写出来我观察当看变量的维度,和
- 当数组通过范围初始化时，我有一些似乎是二维索引;我不知道这是否会给我带来问题
下面的函数重新创建问题，下面的图像显示了我想要的结果:
Sub showProblem()
Dim arr(1 To 2) As Variant
ActiveSheet.Range("A1:C4").Formula = "=rand()"
ActiveSheet.Range("A7:C10").Formula = "=rand()"
arr(1) = ActiveSheet.Range("A1:C4").value
arr(2) = ActiveSheet.Range("A7:C10").value
x = melt(arr, 0, "")
End Sub
Function melt(arrs As Variant, depth As Integer, pathstr)
bc = 1 ' branch count
lc = 1 ' leaf count
On Error GoTo leaf
For Each arrsItem In arrs
y = melt(arrsItem, depth + 1, pathstr & bc & "|")
bc = bc + 1
Next arrsItem
leaf:
Debug.Print (pathstr & arrs)
End Function
扁平化锯齿数组
Option Explicit
Sub ArrJaggedDataTEST()
Const AddressesList As String = "A1:C4,A7:C10" ' add more!?
' Define the source array ('sArr') (depends on the number of addresses).
' Reference the worksheet ('ws').
Dim ws As Worksheet: Set ws = ActiveSheet ' improve
' Using the Split function, write the addresses from the list
' to a 1D zero-based array ('Addresses').
Dim Addresses() As String: Addresses = Split(AddressesList, ",")
' Write the upper limit to a variable ('nUpper')
Dim nUpper As Long: nUpper = UBound(Addresses)
' Since the function is simplified to use only 1D arrays,
' define the 1D one-based source array which will hold
' the values of the ranges in 2D one-based 'range' arrays.
Dim sArr() As Variant: ReDim sArr(1 To nUpper + 1)
' Populate the ranges ('rg') and the source array.
Dim rg As Range ' Current Range
Dim Data() As Variant ' Current Range Array
Dim n As Long ' Current Index in the Addresses Array
For n = 0 To nUpper
' Reference the current range.
Set rg = ws.Range(Addresses(n))
' Write sample data to the current range.
rg.Formula = "=""R""&ROW()&""|""&""C""&COLUMN()"
rg.Value = rg.Value
' Write the data from the current range to the range array.
If rg.Rows.Count + rg.Columns.Count = 2 Then ' one cell
ReDim Data(1 To 1, 1 To 1): Data(1, 1) = rg.Value
Else ' multiple cells
Data = rg.Value
End If
' Assign the range array to the current element of the source array.
sArr(n + 1) = Data
Next n
' Using the function, write the values from the source
' to the destination array.
Dim dArr() As Variant: dArr = ArrJaggedData(sArr)
' Print the indexes and values from the destination array.
For n = 1 To UBound(dArr)
Debug.Print n, dArr(n)
Next n
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose: Returns the values from a one-based jagged array, holding
' only any number of 2D one-based arrays, in a 1D one-based array.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function ArrJaggedData( _
ByVal JaggedData As Variant) _
As Variant
Dim nCount As Long: nCount = UBound(JaggedData)
Dim Counts() As Long: ReDim Counts(1 To nCount, 1 To 2)
Dim n As Long
Dim dCount As Long
For n = 1 To nCount
Counts(n, 1) = UBound(JaggedData(n), 1)
Counts(n, 2) = UBound(JaggedData(n), 2)
dCount = dCount + Counts(n, 1) * Counts(n, 2)
Next n
Dim dArr() As Variant: ReDim dArr(1 To dCount)
Dim d As Long
Dim r As Long
Dim c As Long
Dim rCount As Long
Dim cCount As Long
For n = 1 To UBound(JaggedData)
rCount = Counts(n, 1)
cCount = Counts(n, 2)
For r = 1 To rCount
For c = 1 To cCount
d = d + 1
dArr(d) = JaggedData(n)(r, c)
Next c
Next r
Next n
ArrJaggedData = dArr
End Function
结果
1 R1|C1
2 R1|C2
3 R1|C3
4 R2|C1
5 R2|C2
6 R2|C3
7 R3|C1
8 R3|C2
9 R3|C3
10 R4|C1
11 R4|C2
12 R4|C3
13 R7|C1
14 R7|C2
15 R7|C3
16 R8|C1
17 R8|C2
18 R8|C3
19 R9|C1
20 R9|C2
21 R9|C3
22 R10|C1
23 R10|C2
24 R10|C3
For Each按列主顺序枚举数组(即从第一列向下，然后从第二列向下等)。您还会对VBA中预期的尺寸与您认为在Excel中看到的尺寸相反这一事实感到困惑。
考虑excel
中的下列表格1 2 3 4 5
6 7 8 9 10
你可能认为这是一个5 x 2的数组。当传输到VBA时，它是一个2 x 5数组。
如果你声明下面的'Dim myArray(1到5,1到2)'，你将得到一个数组，其中第一个维度的范围是1到5，第二个维度的范围是1到2。Ie。在VBA中，我们将数组指定为列数除以行数。
因此，转换到VBA的Excel范围给出了第一个维度第一个维度表示行数，第二个维度表示列数。
使用工作表函数转置将excel排列直接转换为vba排列。但一定要记住，当你将数组赋值给一个范围时，要再次进行转置。