引用工作表名称代码完善

zjgldy

请老师帮助，簿中的代码如何修改成A列只有一行数据的也汇总。
0506添加表名称及汇总行.rar (45.02 KB, 下载次数: 4)

2019-5-6 10:37 上传

点击文件名下载附件

lidayu

请测试
Sub ldy()
Dim rg As Range, wk As Worksheet
Set d = CreateObject("scripting.dictionary")
For Each wk In Worksheets
With wk
    For Each rg In .Range("a1:a" & .Cells(Rows.Count, 1).End(3).Row - 1)
        rgs = rg.MergeArea.Count
        rg.UnMerge
        rg.Resize(rgs) = rg
        d(rg.Value) = ""
    Next
        For Each rn In d.keys
            w = WorksheetFunction.Match(rn, .Range("a1", .[a1].End(4)), 0)
            ws = WorksheetFunction.CountIf(.Range("a1", .[a1].End(4)), rn)
                .Range("A" & w).EntireRow.Insert
                .Range("A" & w & ":B" & w).Merge
                .Range("a" & w) = wk.Name
                .Range("a" & w).Resize(1, 5).Font.Bold = True
                .Range("a" & w)(1, 3).Resize(1, 3) = Array("合计", "大号", "小号")
                .Range("A" & w + ws + 1).EntireRow.Insert
                .Range("A" & w + ws + 1) = "合计："
                .Range("A" & w + ws + 1)(1, 3) = WorksheetFunction.Sum(.Range("c" & w + 1 & ":c" & w + ws)) * 1
                .Range("A" & w + ws + 1)(1, 4) = WorksheetFunction.Sum(.Range("d" & w + 1 & ":d" & w + ws)) * 1
                .Range("A" & w + ws + 1)(1, 5) = WorksheetFunction.Sum(.Range("e" & w + 1 & ":e" & w + ws)) * 1
                .Range("A" & w + ws + 1)(1, 3).Resize(1, 3).NumberFormatLocal = "0;;"
                .Range("A" & w + ws + 1).Resize(1, 5).Font.Bold = True
               
            Next
        For i = .Cells(Rows.Count, 1).End(3).Row To 2 Step -1
            If .Range("a" & i) = .Range("a" & i).Offset(-1, 0) Then
                Application.DisplayAlerts = False
                .Range("a" & i).Offset(-1, 0).Resize(2, 1).Merge
                Application.DisplayAlerts = True
            End If
        Next
End With
d.RemoveAll
Next
End Sub

zjgldy

lidayu 发表于 2019-5-6 10:38
请测试
Sub ldy()
Dim rg As Range, wk As Worksheet

谢谢你的帮助。