请指点一下,这种写法是不是属于三维数组?

hcy1185

请老师指点一下!工作表代码的这种写法是不是属于三维数组?

声明三维数组并给三维数组赋值.rar (16.79 KB, 下载次数: 7)

2023-2-25 12:27 上传

点击文件名下载附件

micch

这种问题截图就好了嘛，发个文件多麻烦

dim Arr(1 to 9, 1 to 9, 1 to 9)

做数独的时候用过，不好用

mmwwdd

三维数组就很复杂了，一般不要用到三维

三坛老窖

mmwwdd 发表于 2023-2-25 17:57
三维数组就很复杂了，一般不要用到三维

是的，一般用不到三维以上的数组，但也有不一般的情况。
老窖在火柴棍游戏中用到过四维数组，还行，容易理解，给解决问题带来方便。

hcy1185

三坛老窖 发表于 2023-2-26 00:16
是的，一般用不到三维以上的数组，但也有不一般的情况。
老窖在火柴棍游戏中用到过四维数组，还行，容易 ...

代码还有点问题,请大师指点,谢谢!


Sub 声明三维数组并给三维数组赋值()
    Dim sht As Worksheet, z As Integer, x As Integer, y As Integer, arr() As Variant
    Dim k As Integer, i As Integer, j As Integer
    Dim a As Integer, b As Integer, c As Integer, m As Integer, n As Integer
    Dim dic As Object, brr() As Variant
    Set dic = CreateObject("scripting.dictionary")
    Application.DisplayAlerts = False '禁止警告对话框
    Rem 创建三维数组
    For Each sht In Worksheets
        If sht.Name <> "汇总表" Then
            sht.Range("k:q").Delete '删除备写入列区域
            z = ThisWorkbook.Sheets.Count
            x = sht.UsedRange.Rows.Count
            y = sht.UsedRange.Columns.Count
            ReDim arr(1 To z, 1 To x, 1 To y) As Variant
        Else
            sht.Delete '删除工作表Exit For
        End If
    Next
    Rem 三维数组赋值
    For k = 1 To z
        For i = 1 To x
            For j = 1 To y
                arr(k, i, j) = Sheets(k).Cells(i, j)
            Next
        Next
    Next
    a = UBound(arr, 1)
    b = UBound(arr, 2)
    c = UBound(arr, 3)
    'MsgBox "数组包含的元素个数为：" & a * b * c
    Rem 从三维数组把数据写入工作表单元格
    For k = 1 To a
        For i = 1 To b
            For j = 1 To c
                Sheets(k).Range("a1").Offset(0, 10).Cells(i, j) = arr(k, i, j)
            Next
        Next
    Next
    Rem 新建工作表,从三维数组把数据到汇总工作表
    Sheets.Add before:=Sheet1
    Sheets(1).Name = "汇总表"
    ReDim brr(1 To b * 3 - 2, 1 To 7)
    For k = 1 To a
        m = IIf(k = 1, 1, 2) '一维时保留标题行
        For i = m To b
            n = n + 1
            For j = 1 To c
                brr(n, j) = arr(k, i, j)
                'Sheets("汇总表").Cells(n, j) = arr(k, i, j)
            Next
        Next
    Next
    Erase arr '释放数组
    For i = 1 To UBound(brr, 1)
        If Not dic.exists(brr(i, 3)) Then
            dic(brr(i, 3)) = brr(i, 7)
        Else
            dic(brr(i, 3)) = dic(brr(i, 3)) + brr(i, 7)
        End If
    Next
    Range("c1").Resize(dic.Count, 1) = Application.Transpose(dic.keys) '一列输出,dic.keys
    Range("g1").Resize(dic.Count, 1) = Application.Transpose(dic.items) '一列输出,dic.items
    For i = 1 To UBound(brr, 1)
        If Cells(i, 3) = brr(i, 3) Then
            Cells(1, 1) = brr(1, 1): Cells(i + 1, 1) = i
            Cells(i, 2) = brr(i, 2)
            Cells(i, 4) = brr(i, 4)
            Cells(i, 5) = brr(i, 5)
            Cells(i, 6) = brr(i, 6)
        End If
    Next
    Erase brr '释放数组
    Set dic = Nothing '释放字典
    Application.DisplayAlerts = True '显示警告对话框
End Sub