批量替换指定字符前后的数据

SCWYZJ

求助;怎样批量替换指定字符前后的全部数据（见附件），请老师帮忙看看，谢谢！

orr89

Sub 替换字符()
    arr = Range("b3:c" & [b60000].End(xlUp).Row)
    ReDim brr(1 To UBound(arr), 1 To 1)
    For a = 1 To UBound(arr)
        替换 = Split(arr(a, 1), ".")
        brr(a, 1) = arr(a, 2) & "." & 替换(1)
    Next
    [d3].Resize(UBound(brr), 1) = brr
End Sub

shenjianrong163

正则替换：

1. Sub test()
   
2.     Dim i, r, arr
   
3.     Application.ScreenUpdating = False
   
4.     Set oRegExp = CreateObject("vbscript.regexp")
   
5.     With oRegExp
   
6.         .Global = True
   
7.         .IgnoreCase = True
   
8.         .Pattern = "^[\.\w+$]"
   
9.     End With
   
10.     With Sheets("sheet1")
    
11.         r = .Cells(.Rows.Count, 2).End(xlUp).Row
    
12.         arr = .Range("B3:D" & r)
    
13.         For i = 1 To UBound(arr)
    
14.             arr(i, 3) = oRegExp.Replace(arr(i, 1), arr(i, 2))
    
15.         Next
    
16.         .[B3].Resize(UBound(arr), 3) = arr
    
17.     End With
    
18.     Application.ScreenUpdating = True
    
19. End Sub
    

复制代码

shenjianrong163

请参考附件：
VBA指定字符位置批量替换数据.rar (12.42 KB, 下载次数: 19)

2020-2-21 13:29 上传

点击文件名下载附件
1

Chip_Kenny

1. Sub zz()
   
2. Dim a
   
3. a = Range("b3:c" & [c65536].End(3).Row)
   
4. For i = 1 To UBound(a)
   
5.     a(i, 1) = a(i, 2) & Mid(a(i, 1), InStr(a(i, 1), "."))
   
6. Next
   
7. [d3].Resize(i - 1) = a
   
8. End Sub

复制代码

grf1973

D3=C3&RIGHT(B3,LEN(B3)-FIND(".",B3)+1)

SCWYZJ

shenjianrong163 发表于 2020-2-21 13:29
请参考附件：

shenjianrong163老师 非常谢谢你的帮助！

shenjianrong163

SCWYZJ 发表于 2020-2-21 15:58
shenjianrong163老师 非常谢谢你的帮助！

这个正则的适用性要高一些，就算文件名中有多个“.”也可以替换。

1. Sub test()
   
2.     Dim i, r, arr
   
3.     Application.ScreenUpdating = False
   
4.     Set oRegExp = CreateObject("vbscript.regexp")
   
5.     With oRegExp
   
6.         .Global = True
   
7.         .IgnoreCase = True
   
8.         .Pattern = "([.][^.]+)$"     '匹配最后一个符号"."及其后面的字符
   
9.     End With
   
10.     With Sheets("sheet1")
    
11.         r = .Cells(.Rows.Count, 2).End(xlUp).Row
    
12.         arr = .Range("B3:D" & r)
    
13.         For i = 1 To UBound(arr)
    
14.             Set mh = oRegExp.Execute(arr(i, 1))
    
15.             arr(i, 3) = arr(i, 2) & mh(0).Value
    
16.         Next
    
17.         .[B3].Resize(UBound(arr), 3) = arr
    
18.     End With
    
19.     Application.ScreenUpdating = True
    
20. End Sub

复制代码

SCWYZJ

谢谢各位老师，我已搞定 了！