在 VBA 中以定义的名称存储锯齿状数组

Question

我需要以定义的名称存储一个锯齿状数组，以便可以保存它并在重新打开工作簿时引用其内容。下面的代码以正确的尺寸漂亮地创建了锯齿状数组，但 Names.Add 方法会产生“运行时错误 '1004'：应用程序定义的或对象定义的错误”。
在调试相关行时将鼠标悬停在“名称”一词上会出现“对象变量或未设置块变量”的线索。我尝试更改变量名称，使用“Set”语句将 Fee3 数组转换为对象，以及我能想到的任何其他内容。请帮忙。

Sub GetFee3Codes()
Dim r1 As Integer, r2 As Integer, r3 As Integer, r4 As Integer, r5 As Integer, c5 As Integer
Dim Fee3, UserType, ClientType, StartDate, PayerType, RateOrAmt
ReDim Fee3(1), UserType(1), ClientType(3), StartDate(3), PayerType(14), RateOrAmt(14, 3)
    For r1 = 1 To 1
        Fee3(r1) = UserType
        For r2 = 1 To 1
            Fee3(r1)(r2) = ClientType
            For r3 = 1 To 3
                Fee3(r1)(r2)(r3) = StartDate
                For r4 = 1 To 3
                    Fee3(r1)(r2)(r3)(r4) = PayerType
                    For c5 = 1 To 3
                        For r5 = 1 To 14
                            Fee3(r1)(r2)(r3)(r4)(r5) = RateOrAmt
                        Next r5
                    Next c5
                Next r4
            Next r3
        Next r2
    Next r1
    Names.Add Name:="Fee3", RefersTo:=Fee3, Visible:=True
    ThisWorkbook.Save
End Sub

Answer 1

这是我在 cmets 中提到的方法。由于您可以将文本存储在命名范围中，因此您可以将数组序列化为 JSON，然后在需要时反序列化。不过，正如 Ron Rosenfeld 指出的那样，我认为仅在 Workbooks_Open 事件上运行您所拥有的方法会更简单。

您需要添加下面代码中引用的 VBA JSON 项目。

Option Explicit

'You'll need the VBA JSON Project installed https://github.com/VBA-tools/VBA-JSON
'Also, will need a reference to Microsoft Scripting Runtime added
Sub AddJaggedArrayAsName()
    'Create an array
    Dim arrayExample As Variant
    ReDim arrayExample(1 To 2, 1 To 2)
    
    arrayExample(1, 1) = "A"
    arrayExample(1, 2) = "B"
    arrayExample(2, 1) = "C"
    arrayExample(2, 2) = "D"
    
    'Convert the array to JSON and add to name range
    Dim Json As String
    Json = JsonConverter.ConvertToJson(arrayExample, Whitespace:=2)
    ThisWorkbook.Names.Add Name:="Something", RefersTo:=Json, Visible:=True
        
    'Parse the JSON back to an object and iterate
    Dim JsonObject As Object
    Dim RefersToString As String: RefersToString = ThisWorkbook.Names("Something").RefersTo
    Dim JsonStringFromNamedRange As String
    
    'Remove starting equal sign and extra quotes
    JsonStringFromNamedRange = Replace(Mid$(RefersToString, 3, Len(RefersToString) - 3), """""", """")
    Debug.Print JsonStringFromNamedRange 'JSON here
    
    Set JsonObject = JsonConverter.ParseJson(JsonStringFromNamedRange)
    Dim key As Variant
    Dim item As Variant
    
    'Iterate and show values
    For Each key In JsonObject
        For Each item In key
            Debug.Print item
        Next
    Next
    
End Sub