VBA中实现excel批量替换的代码

金刚

还是不行，不能达到效果，如附件测试区效果

兰色幻想

金刚 发表于 2011-3-10 20:05
还是不行，不能达到效果，如附件测试区效果

这次选多少都可以了，注意，在选取被替换区域时，如果是不连续的，要按ctrl进行多个区域的选取。不要选无关区域，象表中的A，F列之外的。
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 j = 1 To UBound(arr, 2)
   For y = 1 To UBound(arr1)
     If arr(x, j) Like IIf(k = 6, arr1(y, 1), "*" & arr1(y, 1) & "*") Then
       arr(x, j) = Application.WorksheetFunction.Substitute(arr(j, 1), arr1(y, 1), arr1(y, 2))
       Exit For
     End If
    Next y
  Next j
  Next x
  被替换区域.Areas(q) = arr
Next q
End Sub

rxj_0414

学习了！{:041:}可是没读懂。

金刚

兰色幻想 发表于 2011-3-10 20:18
这次选多少都可以了，注意，在选取被替换区域时，如果是不连续的，要按ctrl进行多个区域的选取。不要选无 ...

大部分被替换成同一个代码了{:191:}

兰色幻想

有句代码写错了，呵呵，再试试
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

金刚

这回行了，很好用，多谢兰版，这对我们的工作太有用了{:021:}

fjmxwrs

收藏慢慢理解

金刚

兰色幻想 发表于 2011-3-14 10:04
上传一个文件吧

上传了，麻烦兰版了

金刚

再次请教兰版了{:041:}，如果被替换的旧代码A、B包含在文本中,如“在生产过程中投入A和B,同时注意.......”，执行以上非匹配替换功能后不能达到替换效果

兰色幻想

上传一个文件吧