在VBA中创建一个锯齿状数组，写入似乎工作但读取失败类型不匹配

Question

我在 SAP 中，试图将 GuiLabel 的数组转储到锯齿状数组中。

首先我解析孩子的 ID 以获取行和列，同时过滤掉非 GuiLabel 对象。

这部分有效。

我创建了一个表示线条的变体数组，在每个线条元素中我放置了一个字符串数组，表示每个“标签列”。

这部分似乎没有错误

当我尝试从第一个变体数组读回时出现问题。

我关注了这个很棒的帖子 -> How do I set up a "jagged array" in VBA?

到最后，似乎我应该能够使用简单的 Debug.Print myRows(0)(0) 读取我的每个元素，但是我得到类型不匹配！

任何建议表示赞赏！

Function LabelToArray(LblCollection As Variant) As Variant()

    Dim myid As String
    Dim mycolumn As String
    Dim myrow As String
    Dim intLastRow As Integer
    Dim intLastCol As Integer
    Dim myRows As Variant
    Dim myColumns() As String

    ' Create first row
    ReDim myRows(0)

    ' For every child object in the collection
    For Each mychld In LblCollection

        ' Only execute for labels
        If mychld.Type = "GuiLabel" Then

            ' Get column and row of current label
            myid = Split(mychld.ID, "[")(4)
            myid = Mid(myid, 1, Len(myid) - 1)
            mycolumn = Split(myid, ",")(0)
            myrow = Split(myid, ",")(1)

            ' New row ? Reset column counter, set row counter and redim the array of rows
            ' This will fail spectacularly if SAP stop giving rows in numerical order
            If myrow > intLastRow Then intLastCol = 0: intLastRow = myrow: ReDim myRows(myrow)

            ' Reset or resize this line's columns array
            If intLastCol = 0 Then
                ' Set filled out 'myColumns' array into correct 'myRows' object
                If myrow <> 0 Then myRows(myrow - 1) = myColumns
                ' testing, print last column in this row
                If myrow <> 0 Then Debug.Print myColumns(UBound(myColumns))
                ' testing, print first column in this row
                If myrow <> 0 Then Debug.Print myColumns(0)
                ' testing, print number of columns
                If myrow <> 0 Then Debug.Print UBound(myColumns)
                ' Reset myColumns array because we're on a new line
                ReDim myColumns(0)
            Else
                ReDim Preserve myColumns(intLastCol)
            End If

            myColumns(intLastCol) = mychld.Text

            intLastCol = intLastCol + 1

            'Debug.Print mycolumn & "," & myrow

        End If

    Next

    ' Copy last row into array
    myRows(myrow) = myColumns

    ' SEEMS TO WORK FINE UP TO THIS POINT !

    Debug.Print UBound(myRows)
    Debug.Print myRows(0)(0)  'THIS LINE FAILS, TYPE MISMATCH (run-time error 13) ! I also tried cstr(myRows(0)(0))

    LabelToArray = myRows

End Function

Answer 1

如果第二个维度不存在，则会引发该错误。我的钱会继续作为你的问题。

这是一个交错数组的示例，最后一个是空的。最后一行会抛出 Type Mismatch 错误，因为没有第二维。

Dim mainArray(0 To 3) As Variant
Dim subArray As Variant

subArray = Array("A", "B", "C")
mainArray(0) = subArray
Debug.Print mainArray(0)(0)
'prints A

subArray = Array(1, 2, 3, 4)
mainArray(1) = subArray
Debug.Print mainArray(1)(0)
'prints 1

subArray = Split("HELLO|WORLD", "|")
mainArray(2) = subArray
Debug.Print mainArray(2)(0)
'prints HELLO

mainArray(3) = Empty
Debug.Print mainArray(3)(0)
'Type mismatch

查看您的 Locals Window 并测试您的数组是否正确。

正如 cmets 中所述，没有 Preserve 的 ReDim 看起来很可疑 - 我认为您可能正在清除旧数组。