[已解决]再求老师帮我看看代码。。。。。。

过江龙

一下这段代码是zjdh老师帮我写的，用于汇总各工作薄的，在此非常感谢zjdh老师。
Sub subM()
    Application.ScreenUpdating = False
    Set D = CreateObject("scripting.dictionary")
    PathName = ThisWorkbook.Path & "\*.xls"
    dirna = Dir(PathName)
    Do While dirna <> ""
        If dirna <> ActiveWorkbook.Name Then
            Set SourceBook = Workbooks.Open(ThisWorkbook.Path & "\" & dirna, 0, True)
            With SourceBook.Worksheets("在职")
                For Each c In .Range("B2:S2")
                    If c.Value Like "*失业*" Then
                        x = c.Column
                    End If
                Next c
                arr = .Range("A5:P" & .Range("B65536").End(3).Row)
            End With
            For i = 2 To UBound(arr)
                If Not arr(i, 1) Like "*合计*" Then
                 D(arr(i, 2)) = D(arr(i, 2)) + arr(i, x)
                 ALL = ALL + arr(i, x)
                End If
            Next
            SourceBook.Close False
        End If
        dirna = Dir
    Loop
       Range("A3:B300").ClearContents
    Range("A3").Resize(D.Count, 1) = Application.Transpose(D.KEYS)
    Range("B3").Resize(D.Count, 1) = Application.Transpose(D.ITEMS)
    Range("B2") = ALL
    Application.ScreenUpdating = True
End Sub

但以上代码是将汇总表上的姓名与金额清除后，再将汇总出来的金额填写在汇总表上的。我是想将汇总出来的金额与汇总表上同一个人的金额对应相加。不知又该怎样写呢？ 附件.rar (26.45 KB, 下载次数: 3)

2012-3-31 14:31 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

zjdh

2012-3-31 16:12

Sub subM()
    Application.ScreenUpdating = False
    Set D = CreateObject("scripting.dictionary")
    Arr = Range("A2:B" & Range("A65536").End(3).Row)
    ALL = Arr(1, 2)
    For i = 2 To UBound(Arr)
        D(Arr(i, 1)) = D(Arr(i, 1)) + Arr(i, 2)
    Next
    PathName = ThisWorkbook.Path & "\*.xls"
    dirna = Dir(PathName)
    Do While dirna <> ""
        If dirna <> ActiveWorkbook.Name Then
            Set SourceBook = Workbooks.Open(ThisWorkbook.Path & "\" & dirna, 0, True)
            With SourceBook.Worksheets("在职")
                For Each c In .Range("B2:S2")
                    If c.Value Like "*失业*" Then
                        x = c.Column
                    End If
                Next c
                Arr = .Range("A4:P" & Range("A65536").End(3).Row)
            End With
            For i = 2 To UBound(Arr)
                If Not Arr(i, 1) Like "*合计*" Then D(Arr(i, 2)) = D(Arr(i, 2)) + Arr(i, x)
                ALL = ALL + Arr(i, x)
            Next
            SourceBook.Close False
        End If
        dirna = Dir
    Loop
    Range("A3:B1000").ClearContents
    Range("A3").Resize(D.Count, 1) = Application.Transpose(D.KEYS)
    Range("B3").Resize(D.Count, 1) = Application.Transpose(D.ITEMS)
    Range("B2") = ALL
    Application.ScreenUpdating = True
End Sub

跳转到最佳答案楼层

过江龙

难道这个问题用VBA不能解决吗？

zjdh

Sub subM()
    Application.ScreenUpdating = False
    Set D = CreateObject("scripting.dictionary")
    Arr = Range("A2:B" & Range("A65536").End(3).Row)
    ALL = Arr(1, 2)
    For i = 2 To UBound(Arr)
        D(Arr(i, 1)) = D(Arr(i, 1)) + Arr(i, 2)
    Next
    PathName = ThisWorkbook.Path & "\*.xls"
    dirna = Dir(PathName)
    Do While dirna <> ""
        If dirna <> ActiveWorkbook.Name Then
            Set SourceBook = Workbooks.Open(ThisWorkbook.Path & "\" & dirna, 0, True)
            With SourceBook.Worksheets("在职")
                For Each c In .Range("B2:S2")
                    If c.Value Like "*失业*" Then
                        x = c.Column
                    End If
                Next c
                Arr = .Range("A4:P" & Range("A65536").End(3).Row)
            End With
            For i = 2 To UBound(Arr)
                If Not Arr(i, 1) Like "*合计*" Then D(Arr(i, 2)) = D(Arr(i, 2)) + Arr(i, x)
                ALL = ALL + Arr(i, x)
            Next
            SourceBook.Close False
        End If
        dirna = Dir
    Loop
    Range("A3:B1000").ClearContents
    Range("A3").Resize(D.Count, 1) = Application.Transpose(D.KEYS)
    Range("B3").Resize(D.Count, 1) = Application.Transpose(D.ITEMS)
    Range("B2") = ALL
    Application.ScreenUpdating = True
End Sub

过江龙

谢谢老师，我是想将汇总出来的储存在字典的金额与汇总表上同一个人的金额对应相加。

zjdh

过江龙 发表于 2012-3-31 16:19
谢谢老师，我是想将汇总出来的储存在字典的金额与汇总表上同一个人的金额对应相加。

仔细阅读代码，工作原理：先将汇总表原数据读入字典，再将各工作簿信息加入字典.........
你运行2次宏就可见效果啦！！
第一次作为汇总表原来数据（可删减或增加信息）后，第二次就得到效果啦！！

过江龙

谢谢老师，没有认真看代码，抱歉！！！！就是这样的效果。。。。