本帖最后由 兰色幻想 于 2011-3-10 22:13 编辑
excel在替换时一次只能替换一个,如果成批替换设置公式也挺麻烦的,这里兰色就编写了一个批量替换程序,运行后就可以实现批量替换了。
Sub 批量替换()
On Error Resume Next
Dim 被替换区域 As Range
Dim 替换列表区域 As Range
Dim arr, arr1
Set 被替换区域 = Application.InputBox("请选取被替换的区域", "替换提示", , , , , , 8)
100:
Set 替换列表区域 = Application.InputBox("请选取替换规则的两列区域", "替换提示", , , , , , 8)
If UBound(替换列表区域.Value, 2) < 2 Then GoTo 100
arr = 被替换区域.Value
arr1 = 替换列表区域
For x = 1 To UBound(arr)
For y = 1 To UBound(arr1)
If arr(x, 1) Like "*" & arr1(y, 1) & "*" Then
arr(x, 1) = Application.WorksheetFunction.Substitute(arr(x, 1), arr1(y, 1), arr1(y, 2))
Exit For
End If
Next y
Next x
被替换区域 = arr
End Sub
使用方法:
1 、Alt+f11打开VBE编辑器,插入---模块,把上面的代码粘贴到右边的窗口里,然后把光标放在程序语句中间,按F5运行(当然还可以用按钮执行或放在命令栏上执行)。
2、在第一个提示框出现时,选取被替换的区域,这是一个单列的区域。
3、在第二个提示框出现时,选出替换的2列区域,第一列是被替换的字符,第二列是对应替换后的字符。
4、选取后替换就自动完成了,详见下面动画演示。
如果要实现区域且可以选取匹配是否的替换,可以用下面的代码:
Sub 批量替换()
On Error Resume Next
Dim 被替换区域 As Range
Dim 替换列表区域 As Range
Dim arr, arr1
Set 被替换区域 = Application.InputBox("请选取被替换的区域", "替换提示", , , , , , 8)
100:
Set 替换列表区域 = Application.InputBox("请选取替换规则的两列区域", "替换提示", , , , , , 8)
k = MsgBox("你是否要进行匹配替换,匹配点是,否则点“否”", 4 + 64)
If UBound(替换列表区域.Value, 2) < 2 Then GoTo 100
arr = 被替换区域.Value
arr1 = 替换列表区域
For q = 1 To 被替换区域.Areas.Count
arr = 被替换区域.Areas(q)
For X = 1 To UBound(arr)
For y = 1 To UBound(arr1)
If arr(X, 1) Like IIf(k = 6, arr1(y, 1), "*" & arr1(y, 1) & "*") Then
arr(X, 1) = Application.WorksheetFunction.Substitute(arr(X, 1), arr1(y, 1), arr1(y, 2))
Exit For
End If
Next y
Next X
被替换区域.Areas(q) = arr
Next q
End Sub
|