设为首页收藏本站

简字体切换切换到宽版

ExcelHome技术论坛»论坛 › Excel 技术交流与问答 › Excel VBA程序开发 › 合并单元格排序并求和

EH技术汇-专业的职场技能充电站	妙哉！函数段子手趣味讲函数	Excel服务器-会Excel,做管理系统	Excel Home精品图文教程库
HR薪酬管理数字化实战	Excel 2021函数公式学习大典	Excel数据透视表实战秘技	打造核心竞争力的职场宝典
300集Office 2010微视频教程	数据工作者的案头书	免费直播课集锦	ExcelHome出品 - VBA代码宝免费下载
	用ChatGPT与VBA一键搞定Excel	WPS表格从入门到精通	Excel VBA经典代码实践指南

发新帖

查看: 1171|回复: 5

[求助] 合并单元格排序并求和

学不完用不尽

TA的精华主题

TA的得分主题

发表于 2013-10-18 13:24 | 显示全部楼层 |阅读模式

[广告] ★Excel Home云课堂 - 专业的职场技能充电站★ ★Excel三大利器★ ★ 笨办法学VBA全系列★

要求如下：
使用VBA
1、根据左边的数据区域，对各个分公司按照“部门”开头的数字，进行单独升序排序（扩展）
2、排序后，再添加一列，作为 “金额合计”列（只合计金额项）。
注意：“部门”列中，开头数字相同的，在左侧的合计列里，要作为一个部门，并合并为一个单元格。

求助：合并单元格排序并求和.rar (11.67 KB, 下载次数: 10)

合并, 合并单元, 单元, 单元格, 排序

回复

TA的精华主题

TA的得分主题

发表于 2013-10-18 15:19 | 显示全部楼层

[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★免费下载 ★ ★ 使用帮助★

Sub 合并汇总()
Application.DisplayAlerts = False
Columns("G:G").Delete
Columns("G:G").Insert
r = [b65536].End(3).Row
For i = 3 To r '辅助列，部门前的数字
Cells(i, "G") = IIf(Val(Cells(i, 2)) > 0, Val(Cells(i, 2)), Cells(i, 2))
Next
r1 = 3
For i = 3 To r '根据辅助列排序
If Cells(i, 2) = "小计" Then
r2 = i - 1
Range(Cells(r1, 2), Cells(r2, "G")).Sort key1:=Cells(r1, "G")
r1 = i + 1
End If
Next
Cells(2, "G") = "金额合计" 'G列填充
For i = 3 To r + 1
Cells(i, "G") = Cells(i, 4) + Cells(i, 6)
Next
For i = r To 3 Step -1 '合并单元格
If Val(Cells(i - 1, 2)) = Val(Cells(i, 2)) And Val(Cells(i, 2)) <> 0 Then
Cells(i - 1, "G") = Cells(i - 1, "G") + Cells(i - 1, "G").Offset(1, 0)
Range(Cells(i - 1, "G"), Cells(i, "G")).Merge
Cells(i - 1, "G").Interior.ColorIndex = 35
End If
Next
Cells(1, "G").Resize(r + 1, 1).Borders.LineStyle = 1 '边框线
Application.DisplayAlerts = True
End Sub

复制代码

评分

1 查看全部评分

学不完用不尽

回复

TA的精华主题

TA的得分主题

发表于 2013-10-18 15:20 | 显示全部楼层

[广告] ★ExcelHome默写助手 - 不用妈妈陪的默写神器 · Word/WPS插件 · 自定义默写单 · 自定义描红字帖★

请看附件。

求助：合并单元格排序并求和.rar

18.2 KB, 下载次数: 39

回复

学不完用不尽

TA的精华主题

TA的得分主题

楼主| 发表于 2013-10-18 16:39 | 显示全部楼层

[广告] ★Excel Home云课堂 - 专业的职场技能充电站★ ★Excel三大利器★ ★ 笨办法学VBA全系列★

grf1973 发表于 2013-10-18 15:20
请看附件。

对您的无私帮助，首先表示感谢！谢谢您！
另外，再提个小小的要求：能否设置一下G列的数字格式？保留2位小数位。

回复

TA的精华主题

TA的得分主题

发表于 2013-10-18 16:50 | 显示全部楼层

[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★使用手册★

看倒数第三行代码。

Sub 合并汇总()
Application.DisplayAlerts = False
Columns("G:G").Delete
Columns("G:G").Insert
r = [b65536].End(3).Row
For i = 3 To r '辅助列，部门前的数字
Cells(i, "G") = IIf(Val(Cells(i, 2)) > 0, Val(Cells(i, 2)), Cells(i, 2))
Next
r1 = 3
For i = 3 To r '根据辅助列排序
If Cells(i, 2) = "小计" Then
r2 = i - 1
Range(Cells(r1, 2), Cells(r2, "G")).Sort key1:=Cells(r1, "G")
r1 = i + 1
End If
Next
Cells(2, "G") = "金额合计" 'G列填充
For i = 3 To r + 1
Cells(i, "G") = Cells(i, 4) + Cells(i, 6)
Next
For i = r To 3 Step -1 '合并单元格
If Val(Cells(i - 1, 2)) = Val(Cells(i, 2)) And Val(Cells(i, 2)) <> 0 Then
Cells(i - 1, "G") = Cells(i - 1, "G") + Cells(i - 1, "G").Offset(1, 0)
Range(Cells(i - 1, "G"), Cells(i, "G")).Merge
Cells(i - 1, "G").Interior.ColorIndex = 35
End If
Next
Cells(1, "G").Resize(r + 1, 1).Borders.LineStyle = 1 '边框线
Cells(3, "G").Resize(r + 1, 1).NumberFormatLocal = "#,##0.00_ "
Application.DisplayAlerts = True
End Sub

复制代码

评分

1 查看全部评分

学不完用不尽

回复

学不完用不尽

TA的精华主题

TA的得分主题

楼主| 发表于 2013-10-18 19:52 | 显示全部楼层

[广告] ★ExcelHome默写助手 - 不用妈妈陪的默写神器 · Word/WPS插件 · 自定义默写单 · 自定义描红字帖★

grf1973 发表于 2013-10-18 16:50
看倒数第三行代码。

正确，赞一个！
再次表示感谢！谢谢，谢谢您！

回复

发新帖

最新热点 /1

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-4-25 12:52 , Processed in 0.039784 second(s), 17 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号沪ICP备11019229号-2

本论坛言论纯属发表者个人意见，任何违反国家相关法律的言论，本站将协助国家相关部门追究发言者责任！本站特聘法律顾问：李志群律师

快速回复 返回顶部 返回列表