文于2023年7月17日首发于本人同名公众号:Excel活学活用,更多文章案例请搜索关注!
快速浏览
往期合集:【2023年3月】【2023年4月】【2023年5月】【2023年6月】
实用案例:|收费管理系统|"中医诊所收费系统|日期控件|简单的收发存|电子发票管理助手|
内容提要
VBA代码,批量设置单元格格式
大家好,我是冷水泡茶,前两天我分享了一款小工具:Excel VBA Excel表格拆分通用版,有朋友试用以后,反映了一些BUG及使用需求,
1、导出身份证号码显示不全
2、可否自动设置列宽
3、在WPS中报错
......
本来以为简单地添加一两句代码就能搞定,哪知越改越多,干脆还是写篇文章记录一下,也作为一个集中回复。
批量设置数字、日期、文本格式,自动列宽
关于身份证号码,如果全部是数字的话,在EXCEL单元格里会被显示成科学记数法的形式,让人看了就头大,解决方法是把单元格设置成文本格式。
于是我就在SaveToExcel过程中添加一条代码,把所有单元格格式都设置成文本:rng.NumberFormat = "@"
当然,我们要先定义一个Range对象rng,大小就是我们要写入的数据区域大小。这样,身份证号显示的问题似乎解决了,但新的问题又来了:
如果把所有单元格都设置成文本,那么数字、日期也都变成了文本,虽然看上去没什么大的区别,但如果需要进一步处理数据的话,可能就有点麻烦。
所以,我们还是希望日期列就是日期格式,数值就是数值格式。那么就继续改吧:
1、在选择工作表的时候,我们把日期列名,数值列名分别添加到数组arrDateColFields,arrNumColFields里(以便SaveToExcel过程中调用):
Sub CmbSheets_Change() ...... For i = 1 To lastCol If IsDate(arr(2, i)) Then '日期字段 Me.CmbDateColumn.AddItem arr(1, i) ReDim Preserve arrDateColFields(j) arrDateColFields(j) = arr(1, i) j = j + 1 ElseIf IsNumeric(arr(2, i)) And Len(arr(2, i)) < 15 Then '数值字段 Me.CmbNumberColumn.AddItem arr(1, i) ReDim Preserve arrNumColFields(k) arrNumColFields(k) = arr(1, i) k = k + 1 Else '除日期、数值字段,其他可供筛选字段 Me.CmbFilterColumn.AddItem (arr(1, i)) End If Next......end sub
代码解析:
(1)arrDateColFields,arrNumColFields这两个数组我们定义在Userform1模块所有过程之外,作为公众变量。
(2)把字段名添加到数组,我们采用Redim Preserve的方法
(3)数值列增加了一个长度的判断,少于15位。基本上没有这么大的数值,这样就把身份证号排除在数值列之外。
2、在SaveToExcel过程中,设置rng的格式:
Sub SaveToExcel() Dim rng As Range, col As Range '原来导出的是word文件,扩展名改一下 fileName = Replace(fileName, ".docx", ".xlsx") Workbooks.Add With ActiveWorkbook If Me.CkbTitle Then .Sheets(1).Range(Cells(1, 1), Cells(1, UBound(arrTem, 1) + 1)).MergeCells = True .Sheets(1).Range("A1") = Me.TxbTitle .Sheets(1).Range("A1").HorizontalAlignment = xlCenter Set rng = .Sheets(1).Range("A2").Resize(UBound(arrTem, 2) + 1, UBound(arrTem, 1) + 1) Else Set rng = .Sheets(1).Range("A1").Resize(UBound(arrTem, 2) + 1, UBound(arrTem, 1) + 1) End If rng.NumberFormat = "@" rng = Application.WorksheetFunction.Transpose(arrTem) For i = 1 To rng.Columns.Count For j = LBound(arrNumColFields) To UBound(arrNumColFields) If rng.Cells(1, i).Value = arrNumColFields(j) Then Set col = rng.Columns(i) col.NumberFormatLocal = "_ * #,##0.00_ ;_ * -#,##0.00_ ;_ * ""-""??_ ;_ @_ " col.Value = col.Value End If Next For j = LBound(arrDateColFields) To UBound(arrDateColFields) If rng.Cells(1, i).Value = arrDateColFields(j) Then Set col = rng.Columns(i) col.NumberFormatLocal = "yyyy/m/d" col.Value = col.Value End If Next Next rng.Columns.AutoFit .SaveAs fileName:=saveFolder & "\" & fileName .Close End WithEnd Sub
代码解析:
(1)根据是否插入标题,决定是从第一行还是第二行写入数据。
(2)设置rng大小。
(3)把整个rng的格式设置为文本。
(4)写入数据到rng。
(5)循环rng表头,循环数组arrNumColFields,把日期列设为日期格式,循环数组arrDateColFields,把数值列设为会计专用格式(保留2位小数,千位分隔),这里有句代码col.Value = col.Value,看似多此一举,但有它的作用,它通过回填自身来把日期变成真正的日期。
(6)设置rng自动列宽。
(7)保存、关闭文件。
关于批量设置单元格格式的问题,我们在前期分享文章【Excel VBA 按项目把总表拆分】中也有涉及,欢迎参阅。
在WPS中报错的问题
这个我就只能说抱歉了,我目前没有使用WPS,所以能否在WPS中正常运行,是没有经过测试的,理论上WPS应该能兼容OFFICE,大多应该能正常运行。
如果不能正常运行,我暂时没有好的解决办法。
关于WPS,我还是想啰嗦几句:
1、作为国产替代软件,它当然是头牌,好象也没有第二家。
2、我也用过WPS,它的功能已经是非常强大,几乎能完美兼容OFFICE,日常办公写个WORD文档,做个EXCEL表格,制作PPT完全没有问题。
3、但是(最怕这个但是):
(1)它的VBA模块好像是收费的,写到这,我突然想起前段时间在一个公众号的留言与回复,关于Office与Wps哪个好用的问题:
我的回复:
他再回复:
(2)它的广告比较多,收费版(专业版)没用过,不知道有没有广告。
(3)它经常会“自作主张”地把文件的默认打开程序设置成WPS,你改过来不一会它又给你改回去,不胜其烦,干脆把它给卸了。
正文完
喜欢就点个赞、点在看、留个言呗!