========================
'Pattern代码汇总
'^\s 替换行首空格
'^\n 替换行首的换行符
'"^\d\.\s*" 去除序号
'^(.*)$ 匹配整行
========================
Private Sub 批量替换去除无用字符()
Application.ScreenUpdating = False '关闭屏幕刷新
Dim RegExp As Object
Dim SearchRange As Range, Cell As Range
'此处定义正则表达式
Set RegExp = CreateObject("vbscript.regexp")
'初始化正则对象
With RegExp
.Global = True
.IgnoreCase = True
.MultiLine = True
.Pattern = "^\n"
End With
'此处指定查找范围
Set SearchRange = Selection
'遍历查找范围内的单元格
For Each Cell In SearchRange
Set matches = RegExp.Execute(Cell.Value)
If matches.Count >= 1 Then
Cell.Value = RegExp.Replace(Cell.Value, "")
End If
Next
Application.ScreenUpdating = True '开启屏幕刷新
End Sub
========================
Private Sub 单元格内每行内容添加序号()
Application.ScreenUpdating = False '关闭屏幕刷新
Dim RegExp As Object
Dim SearchRange As Range, Cell As Range
'此处定义正则表达式
Set RegExp = CreateObject("vbscript.regexp")
'初始化正则对象
With RegExp
.Global = True
.IgnoreCase = True
.MultiLine = True
.Pattern = "^(.*)$"
End With
'此处指定查找范围
Set SearchRange = Selection
'遍历查找范围内的单元格
For Each Cell In SearchRange
Set matches = RegExp.Execute(Cell.Value)
If matches.Count > 1 Then
For Each Match In matches
n = n + 1
strcell = strcell & n & ". " & Match.Value & Chr(10)
Next
'最后一行多了一个Chr(10),需要截去
Cell.Value = Mid(strcell, 1, Len(strcell) - 1)
End If
Next
Application.ScreenUpdating = True '开启屏幕刷新
End Sub
========================
Public Sub 用空格连接选中单元格内容()
Dim str As String, temp As String, CXrng As Range, XRrng As Range
Set CXrng = Selection
For Each XRrng In CXrng
str = str & Chr(32) & XRrng.Value
XRrng.ClearContents
Next
CXrng(1) = str
End Sub
'连接多个单元格文本,使用Alt+Enter
Public Sub 用Alt+Enter连接选中单元格内容()
Dim str As String, temp As String, CXrng As Range, XRrng As Range
Set CXrng = Selection
For Each XRrng In CXrng
str = str & Chr(10) & XRrng.Value
XRrng.ClearContents
Next
CXrng(1) = str
End Sub
======================
Sub 正则表达式提取匹配文本()
'定义正则对象和单元格区域
Dim rngRg As Range
Dim objRe As Object
'创建正则对象,并将当前选择区域赋值给rngRg
Set objRe = CreateObject("vbscript.regexp")
Set rngRg = Selection
'初始化正则对象
With objRe
.Global = True
.IgnoreCase = True
.MultiLine = True
.Pattern = "AAA"
End With
'遍历选择区域的每个单元格
For Each cell In rngRg
'如果有符合正则表达式的对象
If objRe.test(cell.Value) Then
'将匹配集合的所有对象的值复制给Matches对象
Set Matches = objRe.Execute(cell.Value)
'遍历Mathces对象,将结果输出到右侧单元格内
For countM = 1 To Matches.Count
cell.Offset(0, countM) = Matches(countM - 1)
Next
End If
Next
End Sub
========================
Sub 正则表达式替换内容输出到右侧列()
Application.ScreenUpdating = False '关闭屏幕刷新
'定义正则对象和单元格区域
Dim rngRg As Range
Dim objRe As Object
'创建正则对象,并将当前选择区域赋值给rngRg
Set objRe = CreateObject("vbscript.regexp")
Set rngRg = Selection
'初始化正则对象
With objRe
.Global = True
.IgnoreCase = True
.MultiLine = True
.Pattern = "AAA"
End With
'遍历选择区域的每个单元格
For Each cell In rngRg
'如果有符合正则表达式的对象
If objRe.test(cell.Value) Then
'将匹配集合的所有对象的值进行替换,并输出在右侧一列
cell.Offset(0, 1) = objRe.Replace(cell.Value, "BBB")
End If
Next
Application.ScreenUpdating = True'开启屏幕刷新
End Sub
=======================
=======================
=======================
=======================
=======================
=======================
=======================
=======================
=======================
=======================
=======================
=======================