Excel VBA编程,即宏编程,对于一些比较苛刻的场景,比较有用。比如说批量替换,如果表格中,有1,2,3,4,...,17个村,我要把它们替换成金盆村、木厂村等村的名字时,不得不使用查找替换功能,反复操作17次,如果是只替换一张表格还勉强可以接受,如果有几张表格都需要这种替换,就非常耗时了。另外,就是通过宏编程来实现批量替换。如下:
Sub batch_replace()
Dim vReplace As String, vBeReplace As String, nI As Integer
vReplace = Range("A" & 2).Value
For nI = 1 To 17
vReplace = Range("A" & nI).Value
If InStr(vReplace, "17") > 0 Then
vBeReplace = Replace(vReplace, "17", "高红村")
ElseIf InStr(vReplace, "16") > 0 Then
vBeReplace = Replace(vReplace, "16", "天堂村")
ElseIf InStr(vReplace, "15") > 0 Then
vBeReplace = Replace(vReplace, "15", "川七村")
ElseIf InStr(vReplace, "14") > 0 Then
vBeReplace = Replace(vReplace, "14", "新桥村")
ElseIf InStr(vReplace, "13") > 0 Then
vBeReplace = Replace(vReplace, "13", "羊角村")
ElseIf InStr(vReplace, "12") > 0 Then
vBeReplace = Replace(vReplace, "12", "天山村")
ElseIf InStr(vReplace, "11") > 0 Then
vBeReplace = Replace(vReplace, "11", "鲤云村")
ElseIf InStr(vReplace, "10") > 0 Then
vBeReplace = Replace(vReplace, "10", "聪明村")
ElseIf InStr(vReplace, "9") > 0 Then
vBeReplace = Replace(vReplace, "9", "湾桥村")
ElseIf InStr(vReplace, "8") > 0 Then
vBeReplace = Replace(vReplace, "8", "四新村")
ElseIf InStr(vReplace, "7") > 0 Then
vBeReplace = Replace(vReplace, "7", "夹石村")
ElseIf InStr(vReplace, "6") > 0 Then
vBeReplace = Replace(vReplace, "6", "河堰村")
ElseIf InStr(vReplace, "5") > 0 Then
vBeReplace = Replace(vReplace, "5", "玉泉村")
ElseIf InStr(vReplace, "4") > 0 Then
vBeReplace = Replace(vReplace, "4", "高棚村")
ElseIf InStr(vReplace, "3") > 0 Then
vBeReplace = Replace(vReplace, "3", "遂安村")
ElseIf InStr(vReplace, "2") > 0 Then
vBeReplace = Replace(vReplace, "2", "木厂村")
ElseIf InStr(vReplace, "1") > 0 Then
vBeReplace = Replace(vReplace, "1", "金盆村")
End If
Range("B" & nI).Value = vBeReplace
Next
End Sub
实现效果如下:
主要涉及到的InStr(包含字符串)、Replace(替换字符串)函数,所以上面的代码还是比较容易懂的。
但是上面的代码有很多缺陷,比如我们只想对选中区域的数字进行替换该怎么办?
下面是第二版代码:
Sub batch_replace()
Dim vReplace As String, vBeReplace As String, nI As Integer
Dim r As Range
Dim column_name As String
Dim column_num As Integer
rem 获取选中数据的列名,比如选中的是A列,则返回值为A
column_name = Mid(Selection.Cells(1, 1).Address, 2, 1)
For Each r In Selection
rem 获取列号,比如A2,则返回值为2
column_num = Mid(r.Address, 4, 2)
vReplace = r.Value
If InStr(vReplace, "17") > 0 Then
vBeReplace = Replace(vReplace, "17", "高红村")
ElseIf InStr(vReplace, "16") > 0 Then
vBeReplace = Replace(vReplace, "16", "天堂村")
ElseIf InStr(vReplace, "15") > 0 Then
vBeReplace = Replace(vReplace, "15", "川七村")
ElseIf InStr(vReplace, "14") > 0 Then
vBeReplace = Replace(vReplace, "14", "新桥村")
ElseIf InStr(vReplace, "13") > 0 Then
vBeReplace = Replace(vReplace, "13", "羊角村")
ElseIf InStr(vReplace, "12") > 0 Then
vBeReplace = Replace(vReplace, "12", "天山村")
ElseIf InStr(vReplace, "11") > 0 Then
vBeReplace = Replace(vReplace, "11", "鲤云村")
ElseIf InStr(vReplace, "10") > 0 Then
vBeReplace = Replace(vReplace, "10", "聪明村")
ElseIf InStr(vReplace, "9") > 0 Then
vBeReplace = Replace(vReplace, "9", "湾桥村")
ElseIf InStr(vReplace, "8") > 0 Then
vBeReplace = Replace(vReplace, "8", "四新村")
ElseIf InStr(vReplace, "7") > 0 Then
vBeReplace = Replace(vReplace, "7", "夹石村")
ElseIf InStr(vReplace, "6") > 0 Then
vBeReplace = Replace(vReplace, "6", "河堰村")
ElseIf InStr(vReplace, "5") > 0 Then
vBeReplace = Replace(vReplace, "5", "玉泉村")
ElseIf InStr(vReplace, "4") > 0 Then
vBeReplace = Replace(vReplace, "4", "高棚村")
ElseIf InStr(vReplace, "3") > 0 Then
vBeReplace = Replace(vReplace, "3", "遂安村")
ElseIf InStr(vReplace, "2") > 0 Then
vBeReplace = Replace(vReplace, "2", "木厂村")
ElseIf InStr(vReplace, "1") > 0 Then
vBeReplace = Replace(vReplace, "1", "金盆村")
End If
rem 如果选中的是A3单元格,则将替换后的字符串存入A3单元格右边的第一个单元格,即B3中
Range(Chr(Asc(column_name) + 1) & column_num).Value = vBeReplace
Next
End Sub
上面的代码比第一版的代码要好一些,当然也更复杂一些,但还是有一点小缺陷,那就是行号不能超过两位数,由于时间有限,下次再来改进。
上面的代码通过mid、address函数找出列名、行号,通过asc函数将字符转换成ascii码,加1后再转换成字符,从而找出当前单元格右边的第一个单元格,非常繁琐。
下面是第三版代码:
Sub batch_replace()
Dim vReplace As String, vBeReplace As String, nI As Integer
Dim r As Range
For Each r In Selection
vReplace = r.Value
If InStr(vReplace, "17") > 0 Then
vBeReplace = Replace(vReplace, "17", "高红村")
ElseIf InStr(vReplace, "16") > 0 Then
vBeReplace = Replace(vReplace, "16", "天堂村")
ElseIf InStr(vReplace, "15") > 0 Then
vBeReplace = Replace(vReplace, "15", "川七村")
ElseIf InStr(vReplace, "14") > 0 Then
vBeReplace = Replace(vReplace, "14", "新桥村")
ElseIf InStr(vReplace, "13") > 0 Then
vBeReplace = Replace(vReplace, "13", "羊角村")
ElseIf InStr(vReplace, "12") > 0 Then
vBeReplace = Replace(vReplace, "12", "天山村")
ElseIf InStr(vReplace, "11") > 0 Then
vBeReplace = Replace(vReplace, "11", "鲤云村")
ElseIf InStr(vReplace, "10") > 0 Then
vBeReplace = Replace(vReplace, "10", "聪明村")
ElseIf InStr(vReplace, "9") > 0 Then
vBeReplace = Replace(vReplace, "9", "湾桥村")
ElseIf InStr(vReplace, "8") > 0 Then
vBeReplace = Replace(vReplace, "8", "四新村")
ElseIf InStr(vReplace, "7") > 0 Then
vBeReplace = Replace(vReplace, "7", "夹石村")
ElseIf InStr(vReplace, "6") > 0 Then
vBeReplace = Replace(vReplace, "6", "河堰村")
ElseIf InStr(vReplace, "5") > 0 Then
vBeReplace = Replace(vReplace, "5", "玉泉村")
ElseIf InStr(vReplace, "4") > 0 Then
vBeReplace = Replace(vReplace, "4", "高棚村")
ElseIf InStr(vReplace, "3") > 0 Then
vBeReplace = Replace(vReplace, "3", "遂安村")
ElseIf InStr(vReplace, "2") > 0 Then
vBeReplace = Replace(vReplace, "2", "木厂村")
ElseIf InStr(vReplace, "1") > 0 Then
vBeReplace = Replace(vReplace, "1", "金盆村")
End If
Rem 当前单元格向右偏移一列
r.Offset(0, 1) = vBeReplace
Next
End Sub
第三版代码已经接近完美,通过offset函数,大大简化了代码量。唯一觉得不满意的是太多的if...then...elseif...endif这种结构,上面这种情况使用select case...end select这种方式也不太好,个人觉得最好的方式就是使用字典dictionary。
下面是第四版:
Sub batch_replace()
Dim vReplace As String, vBeReplace As String, nI As Integer
Dim r As Range
Dim i As Integer
Dim dict, keys, items
' 创建Dictionary
Set dict = CreateObject("Scripting.Dictionary")
With dict
.Add "17", "高红村"
.Add "16", "天堂村"
.Add "15", "川七村"
.Add "14", "新桥村"
.Add "13", "羊角村"
.Add "12", "天山村"
.Add "11", "鲤云村"
.Add "10", "聪明村"
.Add "9", "湾桥村"
.Add "8", "四新村"
.Add "7", "夹石村"
.Add "6", "河堰村"
.Add "5", "玉泉村"
.Add "4", "高棚村"
.Add "3", "遂安村"
.Add "2", "木厂村"
.Add "1", "金盆村"
End With
keys = dict.keys
items = dict.items
For Each r In Selection
vReplace = r.Value
For i = 0 To dict.Count - 1
If InStr(vReplace, keys(i)) > 0 Then
vBeReplace = Replace(vReplace, keys(i), items(i))
Exit For
End If
Next
Rem 当前单元格向右偏移一列
r.Offset(0, 1) = vBeReplace
Next
End Sub
本着学习的目的,遍历dictionary可以采用for each....in..的方式,
第五版代码如下:
Sub batch_replace()
Dim vReplace As String, vBeReplace As String, nI As Integer
Dim r As Range
Dim i As Integer
Dim key As Variant
Dim dict As Object
' 创建Dictionary
Set dict = CreateObject("Scripting.Dictionary")
With dict
.Add "17", "高红村"
.Add "16", "天堂村"
.Add "15", "川七村"
.Add "14", "新桥村"
.Add "13", "羊角村"
.Add "12", "天山村"
.Add "11", "鲤云村"
.Add "10", "聪明村"
.Add "9", "湾桥村"
.Add "8", "四新村"
.Add "7", "夹石村"
.Add "6", "河堰村"
.Add "5", "玉泉村"
.Add "4", "高棚村"
.Add "3", "遂安村"
.Add "2", "木厂村"
.Add "1", "金盆村"
End With
For Each r In Selection
vReplace = r.Value
For Each key In dict.keys
If InStr(vReplace, key) > 0 Then
vBeReplace = Replace(vReplace, key, dict(key))
Exit For
End If
Next key
Rem 当前单元格向右偏移一列
r.Offset(0, 1) = vBeReplace
Next
End Sub
最后,可以通过冒号":"将多行代码合并为一行。
第六版代码如下:
Sub batch_replace()
Dim vReplace As String, vBeReplace As String
Dim r As Range
Dim i As Integer
Dim key As Variant
Dim dict As Object
' 创建Dictionary
Set dict = CreateObject("Scripting.Dictionary")
With dict
.Add "17", "高红村": .Add "16", "天堂村": .Add "15", "川七村": .Add "14", "新桥村": .Add "13", "羊角村"
.Add "12", "天山村": .Add "11", "鲤云村": .Add "10", "聪明村": .Add "9", "湾桥村": .Add "8", "四新村"
.Add "7", "夹石村": .Add "6", "河堰村": .Add "5", "玉泉村": .Add "4", "高棚村": .Add "3", "遂安村"
.Add "2", "木厂村": .Add "1", "金盆村"
End With
For Each r In Selection
vReplace = r.Value
For Each key In dict.keys
If InStr(vReplace, key) Then
vBeReplace = Replace(vReplace, key, dict(key))
Exit For
End If
Next key
Rem 当前单元格向右偏移一列
r.Offset(0, 1) = vBeReplace
vBeReplace = Empty
Next
End Sub
代码的改造可以说永无止境,没有最好,只有更好,经过六个版本的改进,代码已经相当精简。之所以一点一点改进,是因为好代码都是一步一步重构而来,并不是一蹴而就的,这是学习提高的必经阶段。
总结,这是本人第一次通过VBA来操作excel数据表,知识方面主要涉及到VB的语法与Excel自身的框架体系,网上的资料太混乱,代码质量普遍不高。在淘宝上也找了相关的书籍,买了本《别怕,Excel VBA其实很简单》,这本书总体来说,不算深入,也不系统,但简单,代码质量还是挺高的。目前也很难找到比这个更好的入门书籍了。