[已解决]自动插入汇总行并汇总

lidayu · 发表于 2017-6-1 18:37

本帖最后由 lidayu 于 2017-6-1 23:19 编辑

因数据量太大且有几个工作簿手动做效益太慢，恳请老师赐教，如何能在大单位后自动插入汇总行并汇总，详情附件中。

自动插入汇总行并汇总.rar (62.49 KB, 下载次数: 5)

lidayu · 发表于 2017-6-1 19:55

恭候老师赐教！

lisachen · 发表于 2017-6-1 19:57

自动插入汇总行并汇总.rar (64.54 KB, 下载次数: 29)

lidayu · 发表于 2017-6-1 20:20

lisachen 发表于 2017-6-1 19:57

lisachen您好，效果很好就是要这样，能否添加下汇总行字体加粗，谢谢您帮助！

lidayu · 发表于 2017-6-1 23:18

lisachen 发表于 2017-6-1 19:57

lisachen您好，用这句Union(Cells(js, 1), Cells(js, 2), Cells(js, 6)).Font.Bold = True实现字体加粗可以吗？

lisachen · 发表于 2017-6-2 09:37

lidayu 发表于 2017-6-1 23:18
lisachen您好，用这句Union(Cells(js, 1), Cells(js, 2), Cells(js, 6)).Font.Bold = True实现字体加粗可 ...

自动插入汇总行并汇总.rar (62.91 KB, 下载次数: 14)

lidayu · 发表于 2017-6-2 10:18

lisachen 发表于 2017-6-2 09:37

lisachen您好，这样更简洁运行更快，非常感谢您的帮助。

lidayu · 发表于 2017-6-2 10:32

lisachen 发表于 2017-6-2 09:37

lisachen您好，有个不请之请不知能否再得到您的赐教，就是工作簿有时候会碰到“软、硬、套肩章都排在一起。
如果再添加A列为条件（例：软肩章同一单位的数量统计，以此类推）代码要如何更改。

lisachen · 发表于 2017-6-2 10:46

本帖最后由 lisachen 于 2017-6-2 11:07 编辑

lidayu 发表于 2017-6-2 10:32
lisachen您好，有个不请之请不知能否再得到您的赐教，就是工作簿有时候会碰到“软、硬、套肩章都排在一起 ...

思路：
aa = arr(i, 1) + Split(arr(i, 2), "→")(0)
If Not d.exists(aa) Then

因为涉及到排序等因素，需要改的太多
需要换一种思路

lisachen · 发表于 2017-6-2 11:14

本帖最后由 lisachen 于 2017-6-2 11:18 编辑

复制代码

Sub lqxs()
Dim arr, i&, aa, r%, arr1()
Dim d, ks, js, j&, k, t
Set d = CreateObject("scripting.dictionary")
Application.ScreenUpdating = False
Sheet1.Activate
arr = [a1].CurrentRegion
For i = 2 To UBound(arr)
aa = arr(i, 1) + Split(arr(i, 2), "→")(0)
If aa <> aa1 Then
r = r + 1
ReDim Preserve arr1(1 To r)
arr1(r) = i
d(aa & r) = r
End If
aa1 = aa
Next
k = d.keys: t = d.items
For i = r To 1 Step -1
ks = arr1(i)
If i <> r Then
js = arr1(i + 1)
Else
js = UBound(arr) + 1
End If
Rows(js).EntireRow.Insert
Cells(js, 2) = k(i - 1) & " 小计"
Rows(js).Font.Bold = True
Cells(js, 6) = Application.WorksheetFunction.Sum(Range(Cells(ks, 6), Cells(js - 1, 6)))
Next
Application.ScreenUpdating = True
End Sub

复制代码

		自动登录	找回密码
密码			注册