急！求VBA数组 字典优化程序（附件运行需40多分钟，还不及Sumif）

山菊花

2841889887 发表于 2014-8-26 18:41
若在“目标表”上C列、D列之间增加九列后，再在“合计”所在和物料1所在列之间增加一列，代码如何修改？请老 ...

Sub 物料用途整理2()
    Dim nR1%, nL1%, nR2&, nR%, nL%, nJe, Arr(), Brr()
    Dim ds As Object
    Set ds = CreateObject("Scripting.Dictionary") '创建字典
    With Sheets("目标表")
        nR1 = .Range("b4").End(xlDown).Row 'B列最后数据行号（中间无空单元格）
        nL1 = .Range("o5").End(xlToRight).Column 'B4向右查找最后一列数据所在列号（中间无空单元格）
        .Range("m6:m" & nR1).ClearContents '清除原统计数据（合计列）
        .Range(.Range("o6"), .Cells(nR1, nL1)).ClearContents '清除原统计数据
        Arr = .Range(.Range("b4"), .Cells(nR1, nL1)).Value '将数据保存到数组
    End With
    With Sheets("数据源表")
        nR2 = .Range("a3").End(xlDown).Row '查找数据最后位置行号
        Brr = .Range("b4:e" & nR2).Value '将数据保存到数组Brr
    End With
    For i = 14 To nL1 - 1 '将物料编码对应列号保存到字典
        ds(Arr(2, i)) = i
    Next
    For i = 4 To nR1 - 3 '将项目&用途对应行号保存到字典
        ds(Arr(i, 1) & Arr(i, 2)) = i
    Next
    For i = 1 To nR2 - 3 '遍历数据
        nJe = Brr(i, 4) '将金额存储到变量nJe
        nL = ds(Left(Brr(i, 3), 4)) '从字典中读取物料编码的列位置
        nR = ds(Brr(i, 1) & Brr(i, 2)) '从字典中读取项目&用途对应的行号
        If nL * nR * nJe <> 0 Then '如果字典中存在物料编码、项目&用途，并且金额不为0
            Arr(3, 12) = Arr(3, 12) + nJe '累加总金额（ M6 单元格位置）
            Arr(3, nL) = Arr(3, nL) + nJe '累加物料编码对应的合计金额（工作表第6行）
            Arr(nR, nL) = Arr(nR, nL) + nJe '按条件累加（物料编码、项目&用途）
            Arr(nR, 12) = Arr(nR, 12) + nJe '累加项目&用途合计金额（工作表M列）
            nR = ds(Brr(i, 1) & "合计") '从字典中读取合计行的行号
            If nR > 0 Then '如果存在
                Arr(nR, nL) = Arr(nR, nL) + nJe '累加金额
                Arr(nR, 12) = Arr(nR, 12) + nJe '按项目累加金额（工作表M列）
            End If
        End If
    Next
    With Sheets("目标表")
        .Range(.Range("b4"), .Cells(nR1, nL1)).Value = Arr '将结果写入工作表
    End With
End Sub

2841889887

谢谢山菊花老师帮助！！！
代码解释有利于初学者理解和运用，太好了，太感动了！
附件中目标表是我原来工作表，为了求助解决问题才简化发出求助，但基本能满足后续工作需要，为了学习和运用又想深入了解代码的含义，自己动手测试，结果是试验部分成功（比如在数据源表上“金额”列前插入列试验成功），部分失败（比如：若在“目标表”上C列、D列之间增加九列后，再在“合计”所在和物料1所在列之间增加一列，就没办法了），其主要原因还是不了解VBA，看来拿来主义同样需要学习，否则寸步难行。

2841889887

若修改为不清空E列至L列及N列就好了（求助时没有讲清楚），E列至L列另有分类合计，N列为核对（已没有必要了），这个问题就不再麻烦总版主山菊花老师了。

山菊花

2841889887 发表于 2014-8-27 11:02
若修改为不清空E列至L列及N列就好了（求助时没有讲清楚），E列至L列另有分类合计，N列为核对（已没有必要了 ...

上面的代码就是这个作用，清除M列以及O列以后的数据。

山菊花

2841889887 发表于 2014-8-27 10:21
谢谢山菊花老师帮助！！！
代码解释有利于初学者理解和运用，太好了，太感动了！
附件中目标表是我原来工 ...

程序中，先将目标表整个数据区域存储到数组Arr()，统计结果也保存到该数组，最后将数组输出到工作表数据区域，完成统计过程。
Arr()是一个二维数组。二维数组是什么样？它跟工作表单元格区域是一模一样的，同样用行和列定位每一个元素，读写它的值。
原来的表，Arr()的数据就是表中的B4:Y705，这个区域的第一行第一列就是B4单元格“项目”，用数组表示就是Arr(1,1)，数组的第3行第3列就是表中的D6单元格，这个单元格保存总计金额，用数组表示这个位置就是Arr(3,3)，数组Arr(7,3)相当于表中的D10单元格（3948.58）。
修改了表的格式后，Arr()的数据就是表中的B4:AI705，“合计”列由原来第3列变成了第12列，程序的改变是Arr(3,3)变成了Arr(3,12)，行号3不变。物料编码原来从第4列开始，后来从第14列开始，所以建立字典时参数作了改变。
对比一下两段程序，理解了数组Arr()就不难了。

2841889887

还需要麻烦总版主：模板运用其他物料时，数据源表上物料出库有数量，但无金额时（这就是总版主讲的“空格”），计算出现错误（少计算金额），若把无金额所在行删除后再运行就没有问题，有没有办法消除此影响（不需要手动处理）？
修改后的目标表上E7：L705假设设置分类合计公式计算后，再运行一次就将该分类合计数据清除了。
看了总版主解释，现在有点意思了开始有点明白了。之前看VBA相关资料，一下接受不了、消化不了，只有结合实际操作，边做边发现问题再解决问题，这样才能掌握、记忆深刻，看来要学习的知识太多，只好找一个切入点来学习了，有总版主指导，我感觉有点开始上路了，谢谢教导！！！

2841889887

这几天看到总版主利用休息时间帮助解决问题，真有点不好意思再打扰了，还请总版主山菊花老师多注意休息！

山菊花

2841889887 发表于 2014-8-27 15:58
... 数据源表上物料出库有数量，但无金额时（这就是总版主讲的“空格”），计算出现错误（少计算金额）， ...

无金额造成少计算金额，不能理解这是什么状况。
程序“If nL * nR * nJe <> 0 Then”，当金额为0时跳过，它不会少计算金额。
如果你的金额不是手工输入的，是用公式得到的，并且为空时是一个空文本，可以而且必须修改程序。
建议上传附件。

山菊花

2841889887 发表于 2014-8-27 15:58
修改后的目标表上E7：L705假设设置分类合计公式计算后，再运行一次就将该分类合计数据清除了。

2楼的代码：
    .Range(.Range("d6"), .Cells(nR1, nL1)).ClearContents
清除D6到最后一个单元格之间的数据，取是D6:Y705，它包含E7:L705区域。

修改后的11楼代码：
   .Range("m6:m" & nR1).ClearContents '清除原统计数据（合计列）
   .Range(.Range("o6"), .Cells(nR1, nL1)).ClearContents '清除原统计数据
第一句清除E6:E705数据，第二句清除O6:AI705数据。
它不清除E7:L705区域的数据。

2841889887

总版主山菊花老师请查收清除F至L数据附件。