VBA的批量替换功能稍微改进下，烦请大神们抽1分钟看看哦

wh119821 · 发表于 2021-5-8 15:24

本帖最后由 wh119821 于 2021-5-8 16:20 编辑

批量替换的VBA.png

如图，之前找大神做了个vba，蓝色部分是做好的，现在，我想增加一个功能，就是替换成了哪个词就在后面列出哪个词。

EXCEL文件在附件中。
另外，我把代码贴下面，对于懒得下载的大神，更方便了哦！

Sub a()
Dim rng As Range
Dim arr
Dim i&
Columns(4).Copy Cells(1, 5)
Set rng = Columns(5)
arr = [a1].CurrentRegion
For i = 2 To UBound(arr)
rng.Replace arr(i, 1), arr(i, 2), xlPart
Next
End Sub

复制代码

zpy2 · 发表于 2021-5-9 05:21

SELECT *,replace(被替换明细表.被替换的词,替换成明细表.被替换的词,替换成明细表.替换成) 替换后 FROM 替换成明细表,被替换明细表 WHERE 被替换明细表.被替换的词 LIKE '%'||替换成明细表.被替换的词||'%'

smhf_6 · 发表于 2021-5-9 09:13

F列不就是B列嘛？

3190496160 · 发表于 2021-5-9 12:04

Sub a()
Dim ar As Variant, br As Variant
Dim i&
Columns(4).Copy Cells(1, 5)
r = Cells(Rows.Count, 5).End(xlUp).Row
br = Range("e1:f" & r)
ar = [a1].CurrentRegion
For s = 2 To UBound(br)
For i = 2 To UBound(ar)
      If InStr(br(s, 1), ar(i, 1)) > 0 Then
         br(s, 1) = Replace(br(s, 1), ar(i, 1), ar(i, 2))
         br(s, 2) = ar(i, 2)
      End If
Next i
Next s
Range("e1:f" & r) = br
MsgBox "ok!"
End Sub

3190496160 · 发表于 2021-5-9 12:05

A-批量替换.rar (75.09 KB, 下载次数: 19)

wh119821 · 发表于 2021-5-10 10:00

3190496160 发表于 2021-5-9 12:05

感谢大神，批量替换功能测试成功，非常感谢

		自动登录	找回密码
密码			免费注册

VBA的批量替换功能稍微改进下，烦请大神们抽1分钟看看哦

最新热点 /1