|
楼主 |
发表于 2019-8-18 22:09
|
显示全部楼层
本帖最后由 qdnzlh 于 2019-8-19 11:29 编辑
本人因工作需要,每月要统计一张报表,数据由透视表功能自动生成。本单位使用的是WPS软件。
但WPS表格的透视表功能目前还不够完善,生成的透视表有的地方没有表格线,不够美观。为此,编了一段VBA代码来对透视表进行完善。暂时收藏于此。
表格样式(笔数及金额数据区原无表格线):
简便起见,表中仅列出两个分公司、三个网点(实际有10多个分公司、60多个网点)。
【WPS表格:用VBA绘制电子表格实线并设置单元格格式】
- Private Sub Worksheet_Change(ByVal Target As Range) 'Change事件触发过程
- ActiveSheet.PageSetup.Zoom = 85 '设置页面输出缩放比例为85%
- r = Range("A65536").End(xlUp).Row '透视表尾行行号
- c = Range("IV4").End(xlToLeft).Column '透视表尾列列号
- Columns("A:A").ColumnWidth = 6.5 + 4
- Columns("B:B").ColumnWidth = 15
- Columns("C:C").ColumnWidth = 9.5
- Columns("D:D").ColumnWidth = 11
- Columns("E:" & IIf(c = 11, "K", "Q")).ColumnWidth = 7
- [E5].Resize(r - 4, c - 4).Font.Name = "Arial Narrow" '设置单元格字体"Arial Narrow"
- [E5].Resize(r - 4, c - 4).Font.Size = "12" '设置单元格字号为"12"号
- [E5].Resize(1, c - 4).NumberFormatLocal = "0" '设置奇数行为整数格式
- [E6].Resize(1, c - 4).NumberFormatLocal = "0.0" '设置偶数行为小数格式
- Application.EnableEvents = False '禁止触发工作表改变事件
- [D5:D6] = [{"日均笔数";"业务收入"}] '纵向数组整体赋值
- [D5:D6].AutoFill Destination:=[D5].Resize(r - 6) '双单元格下拉自动填充数据
- With Range([C5].Resize(2, c - 2).Address & "," & _
- [D5].Resize(2).Address) '由With指定的单元格区域
- .BorderAround , , xlColorIndexAutomatic '单元格区域画边框线[见注释②]
- End With
- '下句复制表格线、单元格格式("0"/"0.0")、字体及字号
- [C5].Resize(2, c - 2).AutoFill Destination:=[C5] _
- .Resize(r - 4, c - 2), Type:=xlFillFormats '双行区域下拉自动填充格式
- With Cells(r - 1, "C").Resize(2, c - 2) '指定的末尾两行单元格区域
- .Borders(xlInsideHorizontal).LineStyle = xlContinuous '单元格区域内部画横线
- End With
- For i = 5 To r - 2 Step 2 '循环终值=尾行行号-2,步长为2
- If Range("A" & i) = "" Then '判断单元格是否为空
- Range("A" & i).Borders(xlEdgeTop).LineStyle = xlNone '抹去单元格顶边实线
- End If
- If Range("B" & i) = "" Then '判断单元格是否为空
- Range("B" & i).Borders(xlEdgeTop).LineStyle = xlNone '抹去单元格顶边实线
- Else
- Range("B" & i).Borders(xlEdgeTop).LineStyle = xlContinuous '在单元格顶边画实线
- Range("B" & i).ShrinkToFit = True '文本收缩至可用列宽
- End If
- Next
- Range("A4:D4").Borders(xlInsideVertical).LineStyle = xlContinuous '单元格区域内部画竖线
- Cells(r - 1, "D").Resize(2) = [{"笔/日/台";"元/月/台"}] '纵向数组整体赋值
- Cells(2, c - 1).Resize(3, 2) _
- .Value = [{"单位:笔,万元","";"","";"","平均值"}] '二维数组整体赋值
- Cells(4, c - 1) = c - 5 & "月" '复原被二维数组赋值覆盖的月份
- Cells(2, c - 1).Resize(1, 2) _
- .HorizontalAlignment = xlHAlignCenterAcrossSelection '跨列居中[见注释①]
- [E4].Resize(1, c - 4).HorizontalAlignment = xlHAlignRight '水平对齐属性=右对齐
- '┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈
- '下面統计有交易的设备台数和月收入合计
- Cells(r + 2, "E").Resize(1, c - 4) = [E4].Resize(1, c - 4).Value '复制表头月份至表尾隔一行的下方
- m = Application.CountIf(Cells(r, "E").Resize(1, c - 5), ">0") '统计透视表末行数值>0的月份个数
- Cells(r + 2, c + 1) = "收入总计"
- Cells(r + 3, "D").Resize(2) = [{"设备数量";"业务收入"}] '单列纵向数组整体赋值
- Cells(r + 4, "E") = "=Sumif($D5:$D" & r - 2 & _
- ",""业务收入""," & "E5:E" & r - 2 & ")" '公式写入单元格[见注释③]
- Cells(r + 3, "E") = "=Round(E" & r + 4 & "/E" & r & ",0)" '计算设备台数
- Cells(r + 3, "E").Resize(2, m).FillRight '首列两格公式向右自动填充
- With Cells(r + 4, "E").Resize(1, m) '指定需汇总的区域对象
- Cells(r + 4, c) = Round(Application.Average(.Value)) '统计1至m月月均业务收入
- Cells(r + 4, c + 1) = Application.Sum(.Value) '统计1至m月业务收入总计
- End With
- Cells(r + 3, c) = Round(Cells(r + 4, c) / Cells(r, c)) '统计设备平均台数
- Cells(r + 4, c + 1).Interior.ColorIndex = 6 '单元格底色置为黄色
- Cells(r + 4, c + 1).Font.ColorIndex = 3 '单元格文字置为红色
- '┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈
- With Cells(r + 2, "D").Resize(3, (c + 1) - 3) '指定需画表格线的单元格区域
- .Borders.LineStyle = xlContinuous '单元区域(含内部)画横竖实线
- .BorderAround Weight:=xlMedium, Color:=&HFF0000 '单元区域外边框画蓝色中粗线
- End With
- Application.EnableEvents = True '允许触发工作表改变事件
- End Sub
复制代码 注释①:xlHAlignCenterAcrossSelection 水平跨列居中常量(H是Horizontal的首字母),常量值=7
注释②:xlColorIndexAutomatic 外边框线条颜色常量,此常量为黑色默认值,但必须写上,不能忽略。
注释③:将Sumif公式依次写入相应月份的业务收入单元格,""业务收入""外套的双引号可将原双引号变成字符。
【说明】
[1]一维数组常量 Array(值1,值2,…,值n) 等,只可对行区域赋值,不能对列区域赋值。列区域赋值必须使用大括号再外套中括号的形式,形如 [{值1; 值2; …; 值n}]。
[2][]括号内只能是常量,不能是变量,如 E4:Q4 就属于单元格地址常量。代码中的[E4]与Range("E4")、Evaluate("E4")、Cells(4,"E")是等价的。[]是Evaluate()的简写形式,其参数只能有一个。但是,Evaluate的参数是字符串,而[]中的参数只能是单元格引用、公式或者值,不能是诸如"E4:Q4"这类带引号的单元格地址。例如:Evaluate("{1,2,3,4}")与[{1,2,3,4}]是等价的。单元格引用可以是多个单元格区域,如[A1:A10,A4:E6]就相当于Evaluate("A1:A10,A4:E6")。
[3]自动填充(.AutoFill)方法会触发工作表改变事件,因此该方法必须放在EnableEvents=False命令的后边,否则本过程将会被频繁调用,导致运行速度奇慢。
[4]在VBA与html中,颜色值字节顺序正好相反,如:html中红色是#ff0000,而VBA中则是&H0000ff。
【代码技巧】
[1]用方括号[]快捷引用单元格区域。比如:[E4]、Range("E4")、Cells(4,"E")、Evaluate("E4")等,这四种引用方式是等价的,但[E4]代码更简单。方括号[]是Application对象的Evaluate方法简写形式,这种形式非常适合引用一个固定的Range对象,不过,方括号[]内不能使用变量。方括号[]内的引用可以是多个单元格区域,如:[C5:K6,D5:D6]。
[2]用双重括号[{}]对数组变量整体赋值。比如:[A1:B4] = arr = [{1,"A";2,"B";3,"C";4,"D"}]。
[3]用空格+下划线( _)对超长代码行断行。但只能在运算符(&+-*/\)之前或之后、逗号点号等号(.,=)之前或之后断行,不能在冒号+等号(:=)之间断行,不能在变量名或关键字中间断行,不能在引号括起的字符串中间断行,不能在常量数组[{…}]中间断行。断行后应尽量考虑运算符或括号与上一行对齐,以使代码易于阅读。
[4]用With语句指定单元格对象,可以精简VBA代码,或缩减代码行长度。
[5]引用工作表函数的两种方法:
① With Cells(r, "E").Resize(1, c - 5) '指定需条件计数的单元格区域
m = Evaluate("Countif(" & .Address & ","">0"")") '统计透视表末行数值>0的月份个数
End With
② m = Application.CountIf(Cells(r, "E").Resize(1, c - 5), ">0")
两种方法的区别是:第一种,函数Countif的第一参数是地址类型的字符串,要通过函数Evaluate才能将其转换为单元格引用 (注意:所谓单元格引用,其实就是引用对象);第二种,函数Countif的第一参数直接就是引用区域对象。
[6]将Sumif函数公式依次写入相应月份的业务收入单元格,""业务收入""外套的双引号可将原双引号变成字符。写入的公式还可以换成 "=SUMPRODUCT(" & Cells(5, i).Resize(r - 6).Address & "*(1-Mod(Row(5:" & r - 2 & "),2)))"。
[7]几种对象表示方法的区别:
① 对象Range("C5:Q6,D5:D6")与对象Range(Cells(5,"C").Resize(2,15).Address & "," & Cells(5,"D").Resize(2).Address),这两种表示法是等价的,括号内的参数都只有一个,但对各单元格区域的操作是独立的。
② 对象Range("C5:Q6","D5:D6")与对象Range(Cells(5,"C").Resize(2,15),Cells(5,"D").Resize(2)),这两种表示法也是等价的,括号内是两个参数,对该对象进行操作时,是将包含两个单元格区域在内的最小区域作为一个整体进行的。
③ 用Union方法连接起来的Union([C5:Q6],[D5:D6])对象,操作效果与前面两种又有不同,当一个区域包含在另一个区域中时,对该对象的操作,是对两个区域合并之后的整体区域进行的,当不完全包含时,操作是各自独立的。
[8]用自动填充方法代替For循环。一般对单元格区域的重复操作,往往会想到for语句,但是for语句因频繁调用对象,需要消耗大量资源,效率很低,其实,如果使用AutoFill方法或FillUp/FillDown/FillLeft/FillRight方法,可一次性实现for语句的循环调用功能,运行速度很快。
|
|