[已解决]求老师帮忙，用代码解决，急等，谢谢！！！！

过江龙

非常感谢老师，你的程序是将汇总表上的姓名与金额清除后，再将汇总出来的金额填写在汇总表上的，是吧。我是想将汇总出来的金额与汇总表上的金额对应相加。不知又该怎样写呢？

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