修改现有函数以处理不同维度/结构的数组

Dav*_*ens 6 arrays excel vba excel-vba powerpoint-vba

我在处理VBA中的某些数组时遇到了问题,或者更具体地说,我无法有效地使用某些现有的子程序/方法来处理不同大小/维度的数组.

从COM对象检索数组,当它们到达一个可预测的,一致的结构时,基于哪个例程返回数组,我们很难让所有函数在同一结构中返回数据.

因此,我正在处理不同的结构,有时是2D数组,但有时是一维数组,其中每个数组项都是变量/数组.

例如,如果我有一个需要2D结构的现有函数arr(0,0),我需要修改它以接受一维数组,其中每个项的类型为Variant(结构类似arr(0)(0)).

我目前在做什么

我禁用错误,并测试第二维的Ubound,知道如果它是一维数组会引发错误.然后我可以根据数组的结构做一个稍微不同的迭代.

  • 我讨厌使用,On Error Resume Next如果我可以避免它,但似乎在这种情况下可能是最有效的.

  • 我也不喜欢依赖Excel.Application.Transpose但没有找到任何可以在PowerPoint中本地执行此操作的方法.

例:

Function GetSmallFromBar(counts As Variant, banner As Variant, categories As Variant) As Variant
Dim small As Object
Dim arrSizeErr As Variant
Dim i As Long
Set small = CreateObject("Scripting.Dictionary")

On Error Resume Next
arrSizeErr = UBound(counts, 2)
arrSizeErr = (Err.Number <> 0)
Err.Clear
On Error GoTo 0

'Array is structured like arr(0)(0) instead of arr(0,1)
If arrSizeErr Then
    counts = Excel.Application.Transpose(counts)
    ReDim Preserve counts(0 To UBound(counts) - 1)
    'Modify for unique array structure
    For i = LBound(categories) To UBound(categories)
        If counts(i) < 100 Then
            small(i) = categories(i)
        End If
    Next
    GoTo EarlyExit
End If

'This works for the expected array structure, arr(0,0)
For i = LBound(categories) To UBound(categories)
    If counts(i, 0) < 100 Then
        small(i) = categories(i)
    End If
Next
EarlyExit:
GetSmallFromBar = small.Items()

Set small = Nothing
End Function
Run Code Online (Sandbox Code Playgroud)

注意:我重新编写数组,因为我需要使用0基数组.

在我的代码中可能有六个地方,我运行这样的东西,每个地方依赖于一个类似但可能不相同的方法.

我很乐意在其他地方修改我的代码,我只是想知道这是否是一个很好的方法,然后我可以标准化为一个函数,并从其他模块调用这是一个潜在的错误,或者是否有另一种方法来更有效地做到这一点.

其他信息和截图

我只使用1维和2维阵列.但有时我会得到一个数组,其中每个项目也是一个Variant类型.这给了我适合,因为我希望我可以修改我在二维数组上使用的一些函数和方法来处理"数组数组"结构.

预期的2D阵列

在此输入图像描述

有问题的变种数组

在此输入图像描述

小智 1

只要您的代码当前有效,我认为就可以了。如果有任何事情,您可能希望将子例程中的某些函数包装到它们自己的函数中,以便可以重用。

Chip Pearson 在他的数组站点上有一个可用函数,可以为您提供数组的维数,然后您可以使用它来确定需要执行的操作:

Public Function NumberOfArrayDimensions(Arr As Variant) As Integer
Dim Ndx As Integer
Dim Res As Integer
On Error Resume Next
    Do
        Ndx = Ndx + 1
        Res = UBound(Arr, Ndx)
    Loop Until Err.Number <> 0
NumberOfArrayDimensions = Ndx - 1
End Function
Run Code Online (Sandbox Code Playgroud)

资料来源:Chip Pearson、VBA Arrays