读出错误定义的多维数组

Question

我有一个数组，我从一个分裂然后切片数组的代码中收集。

请参阅此问题：Split multidimensional array and then slice it

我添加了以下代码：splitted = Application.Transpose(splitted)

现在，数组的定义方式如下：

当我尝试运行以下代码时：

For r = LBound(splitted) To UBound(splitted)
    Debug.Print uniqueValues(splitted(r))
Next r

我收到此错误：run time error 9 subscript out of range

对于原始代码的参考，我收到此输出：

它可以正常使用我的函数，我只能想象它与数组定义的差异有关。

该功能需要此输入：Function uniqueValues(uniqueArray As Variant) As Integer：

Function uniqueValues(uniqueArray As Variant) As Integer
Dim arr As New Collection, a
Dim i As Long

On Error Resume Next
For Each a In uniqueArray
   arr.Add a, a
Next

uniqueValues = arr.Count

End Function

这是dee提供的函数的代码：

Sub SplitMe()
    Dim source As Variant, tempArr As Variant
    source = ActiveSheet.Range("A3:A5")

    If Not IsArray(source) Then _
        Exit Sub

    Dim r As Integer
    Dim parts() As String
    Dim splitted As Variant
    ReDim splitted(LBound(source) To UBound(source))

    For r = LBound(source) To UBound(source)
        parts = VBA.Split(source(r, 1), "\")
        splitted(r) = parts
    Next r

    splitted = Application.Transpose(splitted)
    'ReDim tempArr(LBound(splitted) To UBound(splitted))
    'tempArr = Application.Index(splitted, 0, 1)

    For r = LBound(splitted) To UBound(splitted)
        Debug.Print uniqueValues(splitted(r))
    Next r
End Sub

Answer 1

试试这个：

Sub SplitMe()
    Dim source As Variant, tempArr As Variant
    source = ActiveSheet.Range("A3:A5")

    If Not IsArray(source) Then _
        Exit Sub

    Dim r As Integer
    Dim parts() As String
    Dim splitted As Variant
    ReDim splitted(LBound(source) To UBound(source))

    For r = LBound(source) To UBound(source)
        parts = VBA.Split(source(r, 1), "\")
        splitted(r) = parts
    Next r

    splitted = Application.Transpose(splitted)

    For r = LBound(splitted, 1) To UBound(splitted, 1)
        Debug.Print uniqueValues(splitted, r)
    Next r
End Sub

Function uniqueValues(uniqueArray As Variant, indx As Integer) As Integer

    Dim arr As New Collection, a, s As String
    Dim i As Long

    On Error Resume Next
    For i = LBound(uniqueArray, 2) To UBound(uniqueArray, 2)
        a = uniqueArray(indx, i)
        s = s & IIf(s <> "", ", ", "") & a
        arr.Add a, a
    Next
    Debug.Print s, arr.Count
    uniqueValues = arr.Count

End Function