该文为想要学习VBA编程的会计和编程同学有使用VBA实现Excel自动化处理和一定的个性化定制Excel操作提供参考
第一篇为::VBA简单语法
第二篇为: Excel 编写第一个简单的VBA程序
第三篇为:Excel VBA简单需求实践,包含对Excel基本的读取,校验,复写操作
GitHub文件下载地址:点我下载
1.需求要求:
1.1场景:
目前有一个Excel表模拟示例数据如下
导入IT系统发现报错,报错原因为通过B2,B3,B4关联不到对应的产品,查数据是有的,之后查看Excel导入数据发现B2,B3,B4文字前后都有空格,导致数据识别有问题,那目标就是去除文字前后空格就可以了
1.2历史背景:
因为该场景下需要先下载模板然后填写数据,因为原来的导入Excel解析逻辑不是很明晰,在最短的时间内遵循能在不改动代码的条件下实现功能,同时提高用户填写Excel的体验,那优先考虑使用Excel的宏校验实现该功能
1.3需求实现要求:
1.增加去自动 去除文件前后空格
2.自动对没有填值得必填项进行字段提示校验
3.在保存前自动触发数据去空格和必填项校验
2.Excel数据准备:
2.1新建模板空格校验Excel文档,保存为[模板空格校验.xlsm]启用宏的格式
表格中的数据可以随意准备,只要类似于如下格式即可,并将Sheet1重命名为Prod
2.2 按ALT+F11即可调出VBA编程界面
如果有使用wps的用户,同时按这两个按键没有反应可以参考这篇文件进行VBA编程环境安装
第二篇为: Excel 编写第一个简单的VBA程序
2.3 点击Prod所在的Sheet双击插入模块,编写的代码如下
Sub TrimBlankSpace()
Dim offsetSheet As Worksheet
Set Worksheet = ThisWorkbook.Sheets("Prod") '获取Prod的Sheets
Dim row_d As Integer, column_d As Integer
column_d = Worksheet.Range("IV1").End(xlToLeft).Column '从255往左获取最后一列不为空的列号
row_d = Worksheet.Range("A65536").End(xlUp).Row '从65536往上获取最后一行不为空的行号
If row_d = 1 Then '如果第一列没有值,则强制提示Product Name必填项报错
MsgBox ("Product Name is a mandatory field in sheet[" + CStr(Worksheet.Name) + "]. please provide a valid value for this colum.")
Exit Sub
End If
Dim text_trim As String, text As String
Dim validColum As String
Dim i%
Dim j%
For j = 1 To column_d
'row_d = Worksheet.Range(CNtoW(j) & "65536").End(xlUp).Row '从65536往上获取最后一行不为空的行号
For i = 1 To row_d
text = CStr(Worksheet.Cells(i, j).Value)
text_trim = Trim(text) '使用内置函数去除文字前后空格
'MsgBox (text)
'MsgBox (text_trim)
If text_trim = "" Then '拼装需要弹出校验的列
If validColum <> "" Then
validColum = validColum & " , " & CNtoW(j) & i
Else
validColum = CNtoW(j) & i
End If
ElseIf text <> text_trim Then '去除空格后和原始值不相等则回写该表格数据
Worksheet.Cells(i, j).Value = text_trim
End If
Next i
Next j
If validColum = "" Then
MsgBox ("Data validation finished and no error was found.") '校验成功提示
Else '校验失败提示
MsgBox (validColum + " is a mandatory field in sheet[" + CStr(Worksheet.Name) + "]. please provide a valid value for this colum.")
End If
End Sub
Function CNtoW(ByVal num As Long) As String '数字列号转字母
CNtoW = Replace(Cells(1, num).Address(False, False), "1", "")
End Function
Function CWtoN(ByVal AB As String) As Long '字母列号转数字
CWtoN = Range("A1:" & AB & "1").Cells.Count
End Function
2.4 增加保存前触发调用 TrimBlankSpace过程函数逻辑
双击ThisWorkbook工程,依次选择Workbook>>BeforSave就会自动出现一个方法,在方法中使用
Call Sheets(“Prod”).TrimBlankSpace调用我们定义的函数即可,点击保存之后马上就可以看到会有提示框弹出
2.4 当我们在文字前后打入空格,TrimBlankSpace方法会自动去除空格,当有单元格输入不符合要求时会弹出校验失败提示
2.5 代码解释
因为VBA代码中的注释写的比较详细,所以只是大概说一下处理逻辑
1.先通过Prod获取sheet表,因为我们的代码是写在对应的sheet中,为后续的数据获取做准备
2.获取表格从后往前数有数据的列column_d的列号和从下往上数有数据的行row_d的行号具体的 Worksheet.Range(" ").End()函数还有其他用法,可以参考这
Excel中vba取得区域最大行数或列数的几种方法总结
Range("A"&rows.count).End(xlUp)
Range("a65536").End(xlUp).Row
为查找A列从65536位置的单元格起,向上查找,直到找到最后一个非空单元格为止,并显示其行号
当我们在使用VBA处理EXCEL数据的时候,通常会遇到如下的代码:
Range("a65536").End(xlUp).Row
那么,在Range引用对象中,End属性指的是什么含义呢?包含哪些方法呢?
与Range对象的End属性相关的知识
End属性包含如下四个方向:
xlDown xlToRight xlToLeft xlUp
End 属性应用于返回一个 Range 对象所包含源区域的区域尾端的单元格。等同于按键 End 向上键、End 向下键、End 向左键或 End 向右键。
示例如下:
本示例选定包含单元格 B4 的区域中 B 列顶端的单元格。
Range("B4").End(xlUp).Select
本示例选定包含单元格 B4 的区域中第 4 行尾端的单元格。
Range("B4").End(xlToRight).Select
本示例将选定区域从单元格 B4 延伸至第四行最后一个包含数据的单元格。
3.两层For循环依次便利表格中的每一个元素,获取到值后调用内置函数 Trim()去除前后空格然后在复写进当前单元格等一系列校验操作
4.根据校验数据弹出对应提示框
其中对于有些VBA函数还不太了解的可以参考以下文章,都有具体介绍
第一篇为::VBA简单语法
5.在ThisWorkbook工程中调用全局保存前触发函数
3.总结:
该需求的实现大概如上,因为VBA支持正则表达式,所以把之前的正则表达式匹配文字空格的一版也贴上,因为上面文章去除前后空格用的是VBA内置Trim(0函数,总有没有内置的函数情况存在,所以贴上正则,让VBA的处理想象能力更大,算是抛砖引玉,而且下面的第一版确实有严重的性能问题,上面文章是已经做过优化的版本,所以也可以作为性能优化版本修改的对比
第一版:
Option Explicit
Sub RegularExpression()
Dim reg As Object
Dim mc As Object 'Matchcollection
Dim m As Object 'Match
Set reg = CreateObject("VbScript.regexp") '创建正则项目
With reg
.Global = True '匹配多次
.IgnoreCase = False '匹配大小写
.Pattern = "\S+.*\S+" '正则表达式匹配非空格字符
End With
Dim text As String '拼接字符串
Dim i%
For i = 1 To 10
Set mc = reg.Execute((ThisWorkbook.Sheets(1).Cells(i, 1).Value)) '执行正则匹配
MsgBox (ThisWorkbook.Sheets(1).Cells(i, 1).Value)
For Each m In mc '遍历拼接匹配上单个单元格中的多个字符
text = text + m
MsgBox m
Next
ThisWorkbook.Sheets(1).Cells(i, 1).Value = text '重新赋值去掉空格后的数据
text = ""
Next i
End Sub