[已解决]多层嵌套的一维数组怎么给单元格赋值？

gwfzh

    多层嵌套的一维数组怎么给单元格赋值？

各位老师：

        Sub dc()程序是由“  zax010 ”老师代码借用过来的，想将由 "原始表", "原始表hj", "原始表fhj"得到的各种数据即字典值“ dic(k0(I) & br(j0))”赋值给数组orr0(1 To 3)后，再赋值给该表B:J列（即B:D、E:G、H:J三个区域），由于字典键值有10个，经“or0(0 To d0.Count)”和字典值加载后，数组orr0(1 To 3)变成了一个多层嵌套的一维数组，现怎么将这个 多层嵌套的一维数组orr赋值给该表B:J列（即B:D、E:G、H:J三个区域）？请各位老师帮忙了！谢谢放！！！

多层嵌套数组赋值给单元格.zip (25.67 KB, 下载次数: 9)

2014-7-15 12:21 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

JLxiangwei

2014-7-15 15:34

gwfzh 发表于 2014-7-15 15:25
只得到了一列结果！

Sub dc()                                               '嵌套数组
    Dim dic, d0, brr, cr, m(), sh As Worksheet
    Dim arrtemp
    Set dic = CreateObject("Scripting.Dictionary")
    Set d0 = CreateObject("Scripting.Dictionary")
    cr = Sheet3.[A1].CurrentRegion
    br = Array("原始表", "原始表hj", "原始表fhj", "")
    ReDim Sr0(1 To 3, 1 To UBound(cr, 2))                                       '取得各类总数和
    '    For j = 1 To UBound(cr, 2)
    '        For i = 2 To UBound(cr)
    '            If cr(i, j) <> "" Then d0(cr(i, j)) = ""
    '        Next
    '    Next
    For Each sh In Sheets
        If InStr(sh.Name, "原始表") Then
            brr = sh.Range("A2").CurrentRegion
            For I = 3 To UBound(brr)
                For j = 1 To UBound(cr, 2)
                    For ii = 2 To UBound(cr)
                        If cr(ii, j) <> "" Then
                            If brr(I, 1) = cr(ii, j) And brr(I, 2) <> "" Then d0(cr(ii, j)) = "": Sr0(j, 1) = Sr0(j, 1) + 1                           '取得 "原始表", "原始表hj", "原始表fhj"各类种数
                        End If
                    Next
                Next
            Next
            For I = 3 To UBound(brr)
                If d0.exists(brr(I, 1)) And brr(I, 2) <> "" Then
                    d0(brr(I, 1)) = ""
                    dic(brr(I, 1) & sh.Name) = Array(brr(I, 2), brr(I, 8), brr(I, 10))
                Else
                End If
            Next
        End If
    Next
    k0 = d0.KEYS
    t0 = d0.items
    k = dic.KEYS
    t = dic.items
    ReDim orr0(1 To 3)
    ReDim or0(0 To d0.Count)
    ReDim orr1(1 To 3, 0 To d0.Count)
    '    On Error Resume Next
    For j0 = 1 To 3
        orr0(j0) = or0
    Next
    Stop
    With Sheet6
        For j = 2 To 10 Step 3
'            s = s + 1
'            kk = kk + 1
           j0 = Int(j / 3)
            For I = 0 To d0.Count - 1   ' .[a65536].End(3).Row
'                    orr0(j0 + 1)(I) = dic(k0(I) & br(j0))
'                    orr1(j0 + 1, I) = orr0(j0 + 1)(I)             '怎么给单元格赋值，请老师帮忙了！！！
'                    .Cells(I + 3, j).Resize(1, 3) = orr1(j0 + 1, I)
                    arrtemp = dic(k0(I) & br(j0))
                    .Cells(I + 3, j).Resize(1, 3) = arrtemp '怎么给单元格赋值，请老师帮忙了！！！
            Next
        Next
   
End With
End Sub


认真看了一下，现在改完，请测试

跳转到最佳答案楼层

hwc2ycy

分开取出来放呀。
不管嵌套了多少。

JLxiangwei

具体点的代码没有仔细看
看过的发现两个问题
1、   .Cells(I, j).Resize(1, 3) = orr1 ，当第一次循环的时候I的初始值是0，所以在此会报错。
2、字典的items和keys都是一个一维数组，如果要返回工作表中的话，直接Application.Transpose(dic(k0(I) & br(j0)))一下就OK
     建议定义一个中间数组arrtemp，这样在循环的时候就可以再本地窗口中看见arrtemp的值
For j0 = 0 To 2
        arrtemp = Application.Transpose(dic(k0(I) & br(j0)))
         Stop
         Sheet2.Cells(I, j).Resize(3, 1) = arrtemp    '怎么给单元格赋值，请老师帮忙了！！！
Next
I需要自己更改
自己测试一下

hwc2ycy

1. .Cells(I + 1, j).Resize(1, 3) = orr1(I + 1, 0)

复制代码

hwc2ycy

I是0值，多观察下本地窗口。

gwfzh

hwc2ycy 发表于 2014-7-15 13:37

        : orr1(1,0)(0) : 7 : Variant/Double
        : orr1(1,0)(1) : .8151 : Variant/Double
        : orr1(1,0)(2) : -22.4895 : Variant/Double
[img]file:///C:/Users/Administrator/AppData/Roaming/Tencent/Users/234125165/QQ/WinTemp/RichOle/LXV1%7BJSA12[()%60[B_~)H)@T.jpg[/img]
      “.Cells(I + 3, j).Resize(1, 3) = orr1(I + 1, 0)” 语句， 出现“运行时错误9，下标越界的”错误，更改成“ .Cells(I + 3, j).Resize(1, 3) = orr1(j0 + 1, I)”后，将最后表格“原始表fhj”的A6、A8都赋给了B:J列。

gwfzh

JLxiangwei 发表于 2014-7-15 13:25
具体点的代码没有仔细看
看过的发现两个问题
1、   .Cells(I, j).Resize(1, 3) = orr1 ，当第一次循环的时 ...

谢谢老师帮助，在“    ReDim arrtemp(1 To 3, 1 To d0.Count)”后，按老师的更改还是得不到值！见附件 多层嵌套数组赋值给单元格0.zip (31.68 KB, 下载次数: 2)

2014-7-15 15:06 上传

点击文件名下载附件

gwfzh

hwc2ycy 发表于 2014-7-15 13:37

改为“.Cells(I + 3, j).Resize(1, 3) = orr1(j0 + 1, I) ”语句时，怎么B:J列中的“B:D、E:G、H:J”三个区域都变成了“H:J”列区域的值？即A6、A8的值

JLxiangwei

gwfzh 发表于 2014-7-15 15:06
谢谢老师帮助，在“    ReDim arrtemp(1 To 3, 1 To d0.Count)”后，按老师的更改还是得不到值！见附件
...

你还是没有理解我说的意思



Sub dc()                                               '嵌套数组
    Dim dic, d0, brr, cr, m(), sh As Worksheet
    Dim arrtemp
    Set dic = CreateObject("Scripting.Dictionary")
    Set d0 = CreateObject("Scripting.Dictionary")
    cr = Sheet3.[A1].CurrentRegion
    br = Array("原始表", "原始表hj", "原始表fhj", "")
    ReDim Sr0(1 To 3, 1 To UBound(cr, 2))                                       '取得各类总数和
    '    For j = 1 To UBound(cr, 2)
    '        For i = 2 To UBound(cr)
    '            If cr(i, j) <> "" Then d0(cr(i, j)) = ""
    '        Next
    '    Next
    For Each sh In Sheets
        If InStr(sh.Name, "原始表") Then
            brr = sh.Range("A2").CurrentRegion
            For I = 3 To UBound(brr)
                For j = 1 To UBound(cr, 2)
                    For ii = 2 To UBound(cr)
                        If cr(ii, j) <> "" Then
                            If brr(I, 1) = cr(ii, j) And brr(I, 2) <> "" Then d0(cr(ii, j)) = "": Sr0(j, 1) = Sr0(j, 1) + 1                           '取得 "原始表", "原始表hj", "原始表fhj"各类种数
                        End If
                    Next
                Next
            Next
            For I = 3 To UBound(brr)
                If d0.exists(brr(I, 1)) And brr(I, 2) <> "" Then
                    d0(brr(I, 1)) = ""
                    dic(brr(I, 1) & sh.Name) = Array(brr(I, 2), brr(I, 8), brr(I, 10))
                Else
                End If
            Next
        End If
    Next
    k0 = d0.KEYS
    t0 = d0.items
    k = dic.KEYS
    t = dic.items
    ReDim orr0(1 To 3)
    ReDim or0(0 To d0.Count)
    ReDim orr1(1 To 3, 0 To d0.Count)
    '    On Error Resume Next
    For j0 = 1 To 3
        orr0(j0) = or0
    Next
    Stop
    With Sheet6
        For j = 2 To 10 Step 3
            s = s + 1
            kk = kk + 1
            For I = 0 To d0.Count - 1   ' .[a65536].End(3).Row
                For j0 = 0 To 2
                    arrtemp = Application.Transpose(dic(k0(I) & br(j0)))
                    .Cells(I + 3, j).Resize(3, 1) = arrtemp '怎么给单元格赋值，请老师帮忙了！！！
                Next
            Next
        Next
   
End With
End Sub


我不知道你熬吧数据放在哪，这样足部运行看看结果

gwfzh

JLxiangwei 发表于 2014-7-15 15:14
你还是没有理解我说的意思

结果放在Sheets("H").Cells(I + 3, j).Resize(3, 1)