多工作表汇总

linxiaoxingood

将“工作表”文件夹中的每一个工作簿中的姓名和总分汇总在本工作表。（“工作表”中的每一个工作簿中总分的位置不固定。）请大神出招！谢谢！

网海遨游

Sub aaa()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    Set Tb = ThisWorkbook
    Set sh = Tb.Sheets("sheet1")
    sh.[a2:b10000].Clear
    mp = Tb.Path & "\工作表\"
    mf = Dir(mp & "*.xls*")
    Do
        Set dk = Workbooks.Open(mp & mf)
            Set sht = dk.Sheets("sheet1")
            r1 = sht.[a65536].End(3).Row
            r2 = sh.[a65536].End(3).Row + 1
            sh.Cells(r2, 1) = sht.[b2]
            sh.Cells(r2, 2) = sht.Cells(r1, 2)
         dk.Close
        mf = Dir
    Loop While mf <> ""
    Tb.Save
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.EnableEvents = True
End Sub

linxiaoxingood

网海遨游 发表于 2019-6-12 20:29
Sub aaa()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

谢谢大神！可以运行，但是还有一个问题，就是总分那一行后面如果还有数据，那么应该怎么改呢？比如后面还有个平均分，名次什么的。思路能否这样：找到含有“姓名”单元格，然后读取它下一单元格的内容，总分也一样，读取到含有“总分”单元格的地址后读取它下一单元格的数值。麻烦大神啦！

网海遨游

Sub aaa()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    Set Tb = ThisWorkbook
    Set sh = Tb.Sheets("sheet1")
    sh.[a2:b10000].Clear
    mp = Tb.Path & "\工作表\"
    mf = Dir(mp & "*.xls*")
    Do
        Set dk = Workbooks.Open(mp & mf)
            Set sht = dk.Sheets("sheet1")
            r1 = sht.[a65536].End(3).Row
            r2 = sh.[a65536].End(3).Row + 1
            For Each Rng In sht.Range("a1:a" & r1)
                If Rng.Value = "姓名" Then sh.Cells(r2, 1) = Rng.Offset(0, 1).Value
                If Rng.Value = "总分" Then sh.Cells(r2, 2) = Rng.Offset(0, 1).Value
            Next Rng
         dk.Close
        mf = Dir
    Loop While mf <> ""
    Tb.Save
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.EnableEvents = True
End Sub