修改一下VBA，能实现多列数据的查找、替换和保存

球世俗

Sub 数据替换整理()
Dim arr, brr, j&, i&
arr = Range("AE2:AF41"): brr = Range("R:R")
For j = 1 To UBound(brr)
For i = 1 To UBound(arr)
brr(j, 1) = Replace(brr(j, 1), arr(i, 1), arr(i, 2))
Next i
Next j
Range("R:R").Value = brr
End Sub

这一段代码能实现数据的查找、替换和保存。现在的问题是查找区域我想建个新表单独保存，比如对应表！，该公式只能查找和替换一列数据R：R，现在添加u：u列，x：x列， aa：aa列 也能够替换后保存在原位置，请高手帮我改改。

lushang2018

上传具体文件，单纯的诉求不好测试

剑指E

Sub 数据替换整理()
Dim arr, brr, j&, i&,k&
arr = Range("AE2:AF41")
brr = Range("R1:aa" & rows.count)
for k=1 to ubound(brr,2) step 3
For j = 1 To UBound(brr)
For i = 1 To UBound(arr)
brr(j, k) = Replace(brr(j, k), arr(i, 1), arr(i, 2))
Next i
Next j
Next k
worksheets.add
Range("R1").resize(rows.count,ubound(brr,2))=brr
End Sub

球世俗

lushang2018 发表于 2023-1-19 21:28
上传具体文件，单纯的诉求不好测试

附件已上传，请高手过目！

ykcbf1100

球世俗 发表于 2023-1-19 22:42
附件已上传，请高手过目！

用字典+数组吧。

gwjkkkkk

Sub 数据替换整理()
    Dim ar, i&, Rng As Range, rngFind As Range
   
    Application.ScreenUpdating = False
    ar = Range("AE2:AF41")
    With [A1].CurrentRegion
       Set Rng = Union(.Columns("R"), .Columns("U"), .Columns("X"), .Columns("AA"))
    End With
   
    With Rng
        For i = 1 To UBound(ar)
            Set rngFind = .Find(ar(i, 1), , , xlWhole)
            If Not rngFind Is Nothing Then
              Do
                rngFind = ar(i, 2)
                Set rngFind = .FindNext(rngFind)
              Loop Until rngFind Is Nothing
            End If
        Next i
    End With
   
    Set Rng = Nothing: Set rngFind = Nothing
    Application.ScreenUpdating = True
    Beep
End Sub

gwjkkkkk

请楼主参考。。。

球世俗

ykcbf1100 发表于 2023-1-20 09:46
用字典+数组吧。

非常强大！