如何快速给多个工作表在数据行末尾添加上合计？

huanglicheng

sub aa

Dim MyPath$, MyName$, sh As Worksheet
    Set sh = ActiveSheet
    Dim sht As Worksheet
    Dim r%
‘mypath路径自己设置’
    MyPath = "C:\Documents and Settings\hlc\桌面\学校调资录入模板" & "\"‘
    MyName = Dir$(MyPath & "*.xls")
    Application.ScreenUpdating = False
    Do While MyName <> ""
        Workbooks.Open MyPath & MyName
        For Each sht In Worksheets
            With sht
                r = .[a65536].End(3).Row + 1
                q = r - 3
                If .Cells(r - 1, 1) <> "合计" Then

                    Range(.Cells(3, 9), .Cells(r - 1, 9)) = "=IF(AND(RC[-3]<=0,RC[-1]<=0),,IF((RC[-5]-RC[-10])<0,""不能为负数"",RC[-5]-RC[-10]))"
                    Range(.Cells(3, 14), .Cells(r - 1, 14)) = "=RC[-5]-RC[-10]"
                    Range(.Cells(3, 17), .Cells(r - 1, 17)) = "=RC[-2]+RC[-1]"
                    Range(.Cells(r, 4), .Cells(r, 17)).Formula = "=SUM(R[-" & q & "]C:R[-1]C)"
                    Range(.Cells(r, 1), .Cells(r, 3)).Merge
                    Range(.Cells(r, 1), .Cells(r, 3)).Value = "合计"
                    Range(.Cells(r, 1), .Cells(r, 3)).HorizontalAlignment = xlCenter
                    Range(.Cells(r, 1), .Cells(r, 17)).Borders.LineStyle = 1
                End If
            End With
        Next
        Workbooks(MyName).Close True
        MyName = Dir
    Loop
    MsgBox "已完成"
    Application.ScreenUpdating = True
end sub

yschaizhen

谢谢huanglicheng老师的帮助，经测试‘mypath路径自己设置’
    MyPath = "C:\Documents and Settings\hlc\桌面\学校调资录入模板" & "\"‘
有误，我已经重新上传了五个工作簿的附件，请教师测试。

huanglicheng

点击这里面的按钮
test.zip (12.09 KB, 下载次数: 135)

2011-6-1 12:11 上传

点击文件名下载附件

yschaizhen

谢谢huanglicheng老师几天来耐心解释和帮助，解决了困扰我很久的问题，辛苦了！！！

工工工AAAAA

如果添加的不是合计而是几行文字呢？

jjmysjg

留个记号，谢谢

Huaijiu8

路过，留个记号

ykcbf1100

多文件多表增加合计行，自动跳过空表，自动计算I、N、Q列数据

ykcbf1100

1. Sub ykcbf()   '//2025.4.3   多文件添加合计行
   
2.     Application.ScreenUpdating = False
   
3.     Application.DisplayAlerts = False
   
4.     Set fso = CreateObject("scripting.filesystemobject")
   
5.     p = ThisWorkbook.Path & ""
   
6.     On Error Resume Next
   
7.     Dim tm: tm = Timer
   
8.     For Each f In fso.GetFolder(p).Files
   
9.         If LCase$(f.Name) Like "*.xls*" Then
   
10.             If InStr(f.Name, ThisWorkbook.Name) = 0 Then
    
11.                 Set wb = Workbooks.Open(f, 0)
    
12.                 For Each sht In wb.Sheets
    
13.                     If sht.UsedRange.Count > 1 Then
    
14.                         With sht
    
15.                             r1 = .Columns(1).Find("合计").Row
    
16.                             If r1 = Empty Then
    
17.                                 r = .Cells(Rows.Count, 1).End(3).Row
    
18.                                 arr = .UsedRange
    
19.                                 For i = 3 To UBound(arr)
    
20.                                     .Cells(i, "i") = Application.Sum(.Cells(i, 4).Resize(, 5))
    
21.                                     .Cells(i, "n") = .Cells(i, 9) - .Cells(i, 4)
    
22.                                     .Cells(i, "q") = .Cells(i, "o") + .Cells(i, "p")
    
23.                                 Next
    
24.                                 .Cells(r + 1, 1) = "合计"
    
25.                                 .Cells(r + 1, 1).Resize(, 3).Merge
    
26.                                 For j = 4 To UBound(arr, 2)
    
27.                                     .Cells(r + 1, j) = Application.Sum(.Cells(3, j).Resize(r - 2))
    
28.                                 Next
    
29.                                 .Cells(r + 1, 1).Resize(, UBound(arr, 2)).Borders.LineStyle = 1
    
30.                             End If
    
31.                             ActiveWindow.DisplayZeros = False
    
32.                         End With
    
33.                     End If
    
34.                 Next
    
35.                 wb.Close 1
    
36.             End If
    
37.         End If
    
38.     Next f
    
39.     Application.ScreenUpdating = True
    
40.     MsgBox "共用时：" & Format(Timer - tm, "0.000") & "秒！"
    
41. End Sub
    
42. 
    

复制代码