创建一个空的二维数组
Create an empty 2d array
我不喜欢未初始化的 VBA 数组,因为每次使用 UBound()
或 For Each
之前都需要检查 if array is initialized 以避免异常,并且没有原生的 VBA 函数来检查它。这就是我初始化数组的原因,至少用 a = Array()
将它们清空。这消除了在大多数情况下进行额外检查的需要,因此一维数组没有问题。
出于同样的原因,我尝试创建一个空的二维数组。不可能简单地做 ReDim a(0 To -1, 0 To 0)
,转置 1d 空数组或类似的东西。我偶然遇到的唯一方法是使用 MSForms.ComboBox
,将空数组分配给 .List
属性 并读回。这是在Excel和Word中工作的示例,你需要将UserForm
插入到VBA项目中,将ComboBox
放在上面,并添加以下代码:
Private Sub ComboBox1_Change()
Dim a()
ComboBox1.List = Array()
a = ComboBox1.List
Debug.Print "1st dimension upper bound = " & UBound(a, 1)
Debug.Print "2nd dimension upper bound = " & UBound(a, 2)
End Sub
组合更改后输出为:
1st dimension upper bound = -1
2nd dimension upper bound = 0
实际上调试中确实是空的二维数组:
是否有更优雅的方法来创建一个空的二维数组,而不使用 ComboBox
或一般的 UserForm
控件?
老兄 - 我认为你偶然发现这个 属性 非常疯狂。
我可能会在这里停下来做:
Function Empty2DArray() As Variant
With CreateObject("Forms.ComboBox.1")
.List = Array()
Empty2DArray = .List
End With
End Function
并像这样使用它:a = Empty2DArray
您无需创建用户表单或组合框 - 您只需使用 CreateObject
.
但正如其他人所说,在检查数组是否已初始化时进行错误处理可能更有意义。
这仅适用于 Windows(不适用于 Mac):
Option Explicit
#If Mac Then
#Else
#If VBA7 Then
Private Declare PtrSafe Function SafeArrayCreate Lib "OleAut32.dll" (ByVal vt As Integer, ByVal cDims As Long, ByRef rgsabound As SAFEARRAYBOUND) As LongPtr
Private Declare PtrSafe Function VariantCopy Lib "OleAut32.dll" (pvargDest As Any, pvargSrc As Any) As Long
Private Declare PtrSafe Function SafeArrayDestroy Lib "OleAut32.dll" (ByVal psa As LongPtr) As Long
#Else
Private Declare Function SafeArrayCreate Lib "OleAut32.dll" (ByVal vt As Integer, ByVal cDims As Long, ByRef rgsabound As SAFEARRAYBOUND) As Long
Private Declare Function VariantCopy Lib "OleAut32.dll" (pvargDest As Variant, pvargSrc As Any) As Long
Private Declare Function SafeArrayDestroy Lib "OleAut32.dll" (ByVal psa As Long) As Long
#End If
#End If
Private Type SAFEARRAYBOUND
cElements As Long
lLbound As Long
End Type
Private Type tagVariant
vt As Integer
wReserved1 As Integer
wReserved2 As Integer
wReserved3 As Integer
#If VBA7 Then
ptr As LongPtr
#Else
ptr As Long
#End If
End Type
Public Function EmptyArray(ByVal numberOfDimensions As Long, ByVal vType As VbVarType) As Variant
'In Visual Basic, you can declare arrays with up to 60 dimensions
Const MAX_DIMENSION As Long = 60
If numberOfDimensions < 1 Or numberOfDimensions > MAX_DIMENSION Then
Err.Raise 5, "EmptyArray", "Invalid number of dimensions"
End If
#If Mac Then
Err.Raise 298, "EmptyArray", "OleAut32.dll required"
#Else
Dim bounds() As SAFEARRAYBOUND
#If VBA7 Then
Dim ptrArray As LongPtr
#Else
Dim ptrArray As Long
#End If
Dim tVariant As tagVariant
Dim i As Long
'
ReDim bounds(0 To numberOfDimensions - 1)
'
'Make lower dimensions [0 to 0] instead of [0 to -1]
For i = 1 To numberOfDimensions - 1
bounds(i).cElements = 1
Next i
'
'Create empty array and store pointer
ptrArray = SafeArrayCreate(vType, numberOfDimensions, bounds(0))
'
'Create a Variant pointing to the array
tVariant.vt = vbArray + vType
tVariant.ptr = ptrArray
'
'Copy result
VariantCopy EmptyArray, tVariant
'
'Clean-up
SafeArrayDestroy ptrArray
#End If
End Function
您现在可以创建具有不同维数和数据类型的空数组:
Sub Test()
Dim arr2D() As Variant
Dim arr4D() As Double
'
arr2D = EmptyArray(2, vbVariant)
arr4D = EmptyArray(4, vbDouble)
Stop
End Sub
我不喜欢未初始化的 VBA 数组,因为每次使用 UBound()
或 For Each
之前都需要检查 if array is initialized 以避免异常,并且没有原生的 VBA 函数来检查它。这就是我初始化数组的原因,至少用 a = Array()
将它们清空。这消除了在大多数情况下进行额外检查的需要,因此一维数组没有问题。
出于同样的原因,我尝试创建一个空的二维数组。不可能简单地做 ReDim a(0 To -1, 0 To 0)
,转置 1d 空数组或类似的东西。我偶然遇到的唯一方法是使用 MSForms.ComboBox
,将空数组分配给 .List
属性 并读回。这是在Excel和Word中工作的示例,你需要将UserForm
插入到VBA项目中,将ComboBox
放在上面,并添加以下代码:
Private Sub ComboBox1_Change()
Dim a()
ComboBox1.List = Array()
a = ComboBox1.List
Debug.Print "1st dimension upper bound = " & UBound(a, 1)
Debug.Print "2nd dimension upper bound = " & UBound(a, 2)
End Sub
组合更改后输出为:
1st dimension upper bound = -1
2nd dimension upper bound = 0
实际上调试中确实是空的二维数组:
是否有更优雅的方法来创建一个空的二维数组,而不使用 ComboBox
或一般的 UserForm
控件?
老兄 - 我认为你偶然发现这个 属性 非常疯狂。
我可能会在这里停下来做:
Function Empty2DArray() As Variant
With CreateObject("Forms.ComboBox.1")
.List = Array()
Empty2DArray = .List
End With
End Function
并像这样使用它:a = Empty2DArray
您无需创建用户表单或组合框 - 您只需使用 CreateObject
.
但正如其他人所说,在检查数组是否已初始化时进行错误处理可能更有意义。
这仅适用于 Windows(不适用于 Mac):
Option Explicit
#If Mac Then
#Else
#If VBA7 Then
Private Declare PtrSafe Function SafeArrayCreate Lib "OleAut32.dll" (ByVal vt As Integer, ByVal cDims As Long, ByRef rgsabound As SAFEARRAYBOUND) As LongPtr
Private Declare PtrSafe Function VariantCopy Lib "OleAut32.dll" (pvargDest As Any, pvargSrc As Any) As Long
Private Declare PtrSafe Function SafeArrayDestroy Lib "OleAut32.dll" (ByVal psa As LongPtr) As Long
#Else
Private Declare Function SafeArrayCreate Lib "OleAut32.dll" (ByVal vt As Integer, ByVal cDims As Long, ByRef rgsabound As SAFEARRAYBOUND) As Long
Private Declare Function VariantCopy Lib "OleAut32.dll" (pvargDest As Variant, pvargSrc As Any) As Long
Private Declare Function SafeArrayDestroy Lib "OleAut32.dll" (ByVal psa As Long) As Long
#End If
#End If
Private Type SAFEARRAYBOUND
cElements As Long
lLbound As Long
End Type
Private Type tagVariant
vt As Integer
wReserved1 As Integer
wReserved2 As Integer
wReserved3 As Integer
#If VBA7 Then
ptr As LongPtr
#Else
ptr As Long
#End If
End Type
Public Function EmptyArray(ByVal numberOfDimensions As Long, ByVal vType As VbVarType) As Variant
'In Visual Basic, you can declare arrays with up to 60 dimensions
Const MAX_DIMENSION As Long = 60
If numberOfDimensions < 1 Or numberOfDimensions > MAX_DIMENSION Then
Err.Raise 5, "EmptyArray", "Invalid number of dimensions"
End If
#If Mac Then
Err.Raise 298, "EmptyArray", "OleAut32.dll required"
#Else
Dim bounds() As SAFEARRAYBOUND
#If VBA7 Then
Dim ptrArray As LongPtr
#Else
Dim ptrArray As Long
#End If
Dim tVariant As tagVariant
Dim i As Long
'
ReDim bounds(0 To numberOfDimensions - 1)
'
'Make lower dimensions [0 to 0] instead of [0 to -1]
For i = 1 To numberOfDimensions - 1
bounds(i).cElements = 1
Next i
'
'Create empty array and store pointer
ptrArray = SafeArrayCreate(vType, numberOfDimensions, bounds(0))
'
'Create a Variant pointing to the array
tVariant.vt = vbArray + vType
tVariant.ptr = ptrArray
'
'Copy result
VariantCopy EmptyArray, tVariant
'
'Clean-up
SafeArrayDestroy ptrArray
#End If
End Function
您现在可以创建具有不同维数和数据类型的空数组:
Sub Test()
Dim arr2D() As Variant
Dim arr4D() As Double
'
arr2D = EmptyArray(2, vbVariant)
arr4D = EmptyArray(4, vbDouble)
Stop
End Sub