VBA_用正则环视替换数据

将原始金额 整理成带有","分隔符的数据

例如:

 

 

代码片段:

Option Explicit
Sub 规范格式()
Dim ws As Worksheet
Dim i%, s As String
Dim regex As Object

Set ws = ActiveWorkbook.Worksheets("环视匹配替换")
Set regex = CreateObject("vbscript.regexp")

With regex
.Global = True
.Pattern = "(\d)(?=(\d{4})+元)"
End With

For i = 3 To 11
s = ws.Cells(i, 2).Value
ws.Cells(i, 3) = regex.Replace(s, "$1,")
'$1代表第一个捕获组
'上面这句就是将正则查找的第一个捕获组换成这个捕获组和一个逗号

Next i

End Sub

 

方法2: 使用字符串函数

 

 

代码片段:

Sub separatetext()
Dim ws As Worksheet
Dim i&, j&, k&, p&, x&, s$, m&
Dim r As Range
Dim arr(), brr(), crr() As String

Set ws = ActiveWorkbook.Worksheets("Sheet1")

'最后一行
Set r = ws.UsedRange.Find(what:="*", searchorder:=xlByRows, searchdirection:=xlPrevious)

If Not r Is Nothing Then
i = r.Row
End If

Debug.Print i

brr() = ws.Range("A1:A" & i).Value
'根据最长的文本确定数组的上标
m = 0
For k = 1 To UBound(brr())
If m < Len(brr(k, 1)) Then m = Len(brr(k, 1))
Next k

Debug.Print m
'设置数组界限
ReDim arr(1 To i, 1 To 1)
ReDim crr(1 To m)

k = 1
For k = 1 To i
s = ws.Cells(k, 1).Value
If s <> "" Then
p = Len(s)
'数组循环,每次都重新设置数组的界限
'Erase crr
ReDim crr(1 To p)
For x = 1 To p
'arr(k, x) = Mid(s, x, 1)
crr(x) = Mid(s, x, 1)

Next x
arr(k, 1) = Join(crr(), ",")
End If
Next k

'将结果回填到表格

ws.Range("C1").Resize(UBound(arr(), 1), UBound(arr(), 2)) = arr()

End Sub