Question

我正在研究通过VBA进行二进制序列化和反序列化。

为此，我需要能够动态创建和填充任意数量维度的数组。例如，假设您想要执行类似

的操作

Dim sample(0 To 3, 0 To 4, 0 To 2, 0 To 2) As Integer
sample(3,1,1,0) = 12345

所以创建并填充一个4维数组。如果你在编译时知道维度很容易，但如果你不知道怎么办？

Sub Deserialize()

  ' Dynamic equiavalent of: Dim sample(0 To 3, 0 To 4, 0 To 2, 0 To 2) As Integer
  Dim dimensions(0 To 3) As Integer
  dimensions(0) = 3
  dimensions(1) = 4
  dimensions(2) = 2
  dimensions(3) 2
  Dim sample As Variant
  sample = CreateArrayWithDimensions(dimensions)

  ' Dynamic equivalent of sample(3,1,1,0) = 12345
  Dim index(0 To 3) As Integer
  index(0) = 3
  index(1) = 1
  index(2) = 1
  index(3) = 0
  Call SetArrayValue(sample, index, 12345)
End Sub

这有可能吗？或者换句话说，有没有办法实现pseuod函数CreateArrayWithDimensions和SetArrayValue？

由于

Answer 1

没有优雅的解决方案。 Sub DimTest() Dim sample() As Integer Dim dimensions(0 To 3) As Integer Dim index(0 To 3) As Integer dimensions(0) = 10 dimensions(1) = 20 dimensions(2) = 40 dimensions(3) = 70 index(0) = 1 index(1) = 2 index(2) = 4 index(3) = 7 sample = CreateArrayWithDimensions(dimensions) SetArrayValue sample, index, 12345 End Sub Function CreateArrayWithDimensions(dimensions() As Integer) As Integer() Dim b() As Integer Select Case UBound(dimensions) Case 1: ReDim b(dimensions(0)) Case 2: ReDim b(dimensions(0), dimensions(1)) Case 3: ReDim b(dimensions(0), dimensions(1), dimensions(2)) Case 4: ReDim b(dimensions(0), dimensions(1), dimensions(2), dimensions(3)) Case 5: ReDim b(dimensions(0), dimensions(1), dimensions(2), dimensions(3), dimensions(4)) End Select CreateArrayWithDimensions = b End Function Sub SetArrayValue(sample() As Integer, idx() As Integer, value As Integer) Select Case UBound(idx) Case 1: sample(idx(0)) = value Case 2: sample(idx(0), idx(1)) = value Case 3: sample(idx(0), idx(1), idx(2)) = value Case 4: sample(idx(0), idx(1), idx(2), idx(3)) = value Case 5: sample(idx(0), idx(1), idx(2), idx(3), idx(4)) = value End Select End Sub不能接受变量数量的参数。但是，如果你可以限制“任意”，你可以尝试这样的事情：

另一种（更灵活的）解决方案是使用良好的旧1维线性存储概念（实际上系统存储数组的方式），并计算实际条目的实际位置。

Answer 2

如何使用＆＃39;字典＆＃39;而不是多维数组。密钥可以是所有索引的串联。

添加对Microsoft Scripting Runtime的引用或将其更改为后期绑定。

Option Explicit

Dim sample As New Scripting.Dictionary

Sub test()
    Dim index(0 To 3) As Integer
    index(0) = 3
    index(1) = 1
    index(2) = 1
    index(3) = 0
    Call SetArrayValue(sample, index, 12345)
    Debug.Print GetArrayValue(sample, index)
End Sub

Sub SetArrayValue(sample As Dictionary, index() As Integer, val As Variant)
    Dim key As String
    key = createIndexKey(index)
    If sample.Exists(key) Then
        sample(key) = val
    Else
        Call sample.Add(key, val)
    End If
End Sub

Function GetArrayValue(sample As Dictionary, index() As Integer) As Variant
    Dim key As String
    key = createIndexKey(index)
    If sample.Exists(key) Then
        GetArrayValue = sample(key)
    Else
        GetArrayValue = Null
    End If
End Function

Function createIndexKey(index() As Integer)
    Dim i As Integer
    createIndexKey = ""
    For i = LBound(index) To UBound(index)
        createIndexKey = IIf(createIndexKey = "", "", ":") & index(i)
    Next i
End Function

在编译时未知维度

2 个答案: