excelVBA把⼀个单元格内容按逗号拆分并依次替换到另⼀个单元格的括号⾥⾯(本题例⼦,把。。。
⽅法1:运⽤excel单元格拆分合并实现
思路:⽤VBA正则查询左侧括号个数,对右侧单元格逐⼀按逗号、顿号等符号分列,同时左侧按括号分列(分列只能按括号单边分列),分列完成后按要求合并,本题事例把括号换成{}+把对应答案的空填⼊,本题先按逗号分列,再按顿号。分列后按左侧分出来的第⼀列和右侧分出来第⼀列先合并,第⼆第三.....依次类推,合并再次⽤正则匹配,此时匹配{}的个数,如果同⾏{}个数和替换之前()的⼀致,说明是拆分正确的。然后筛选不⼀致的,重新按新的符号拆分,拆分后操作和第⼀次的⼀致,依次类推,直到都处理完为⽌。
结果展⽰:
技巧:1.分列前可⽤通过vba匹配括号数最多的⾏来决定最⼤的分列数量,防⽌分列覆盖其它值。
2.合同按左1和右1,左2和右,左3和右3此⽅式,同时合并的时候要增加⽂本{}的合并。例⼦=F3&"{"&N3&"}"&G3&"{"&O3&"}"&H3&" {"&P3&"}"&I3
------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
⽅法2:VBA代码实现⽅法1
Function zhengze(ze As String, Rng As Range, Rng1 As Range)
Set regx = CreateObject("p")
With regx
.Global = True
.Pattern = ze '写正则表达式
Set mat = .Execute(Rng)
result = Split(Rng1, ",") '知识点:Split函数将⼀个字符串,以特定符号为分隔符,分列成⼀个下标为0的数组
result1 = Split(Rng, "()")
l = UBound(result) + 1    'UBound返回数组上限,加1为数组长度
l1 = UBound(result1) + 1
If .test(Rng) Then '⽆匹配值则为空|匹配成功执⾏循环
Dim m As String
If mat.Count > 1 Then  '为多个匹配结果则合并显⽰,否则显⽰当前值
For i = 1 To l      'vba中数值循环需要⽤for i=value to var/其它⽤for each i in var
m = m & result1(i - 1) & "{" & result(i - 1) & "}" '循环并合并匹配结果
Next
逗号分割的字符串转数组
If l1 - 1 = l Then    '此层IF⽤于判断需要填充的个数和单元格按符号拆除的是否⼀致,不⼀致说明拆分有误,返回原单元格⽂本
If l1 = l Then      '此层IF⽤于判断,当填充符号不处于末端且原⽂本按填充符号拆分后列表个数⽐需要填充值的个数多时分情形合并
zhengze = m
ElseIf l1 > l Then
zhengze = m & result1(l)
Else
zhengze = Rng
End If
Else
zhengze = Rng
End If
Else
zhengze = mat(0).value    '参数存储是⼀个列表形式,不能直接=号取值,必须⽤列表固有取值⽅式
End If
Else
zhengze = Rng
End If
End With
End Function
效果展⽰
注释:参数1为正则表达式/需匹配的⽂本,事例为中⽂状态下的括号;参数2为需要操作的⽂本;参数3为需要按特定符号拆分的⽂本。
----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
⽅法3:VBA代码实现⽅法2
Function zhengze2(ze As String, Rng As Range, Rng1 As Range, Split_symbol)
Set regx = CreateObject("p")
With regx
.Global = False
.Pattern = ze '写正则表达式
Set m = Rng    '把要执⾏替换的单元格赋值给参数m,在后续步骤通过循环把每⼀次执⾏⾸次匹配的符号换掉并⽣成新的⽂本,依次执⾏,直到完全替换为⽌
n = Split(Rng, ze)
n1 = Split(Rng1, Split_symbol)
n_length = UBound(n)
n1_length = UBound(n1) + 1    '此处多加1是因为⼀般拆分的符合⼀般位于⽂本中间,⽽被替换的符号可能位于头和尾,拆分后会⽐符号数量多1,所以不需要加1
If n_length = n1_length Then
For i = 1 To n_length
m = .Replace(m, "{" & n1(i - 1) & "}")  '此处运⽤可能会出现的问题:当n_length⼤于n1_length,会导致n1(n-1)不存在⽽返回错误值,所以外层增加if循环既可以避免返回错误值,也可以达到提⽰拆分错误的效果
Next
zhengze2 = m
Else
zhengze2 = "拆分错误,不能按此符号拆分"
End If
End With
End Function
效果展⽰
本例⼦实现思路:运⽤正则表达式,通过设置.Global = False,只匹配B7第⼀次出现括号的地⽅,把C7
按逗号拆分并存储为⼀个数组n1,同时把B7按括号拆分并存储为⼀个数组n,通过循环,逐⼀替换B7每⼀次第⼀次出现括号的地⽅,并以n的长度即括号个数决定循环次数来实现把B7单元格的括号全部替换完成。
-------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
扩展:替换结果如果要恢复原来的格式,可以插⼊辅助符号如“|”改变格式“|{⽉结}|”,然后按“|”拆分,再把答案位于的列合并后再⽤替换函数对每个答案逐⼀替换即可
VBA代码实现:
Function zhengze1(ze As String, Rng As Range)
Set regx = CreateObject("p")
With regx
.Global = True
.Pattern = ze '写正则表达式
Set mat = .Execute(Rng)
'MsgBox mat.Count
If .test(Rng) Then '⽆匹配值则为空|匹配成功执⾏循环
Dim m As String
If mat.Count > 1 Then  '为多个匹配结果则合并显⽰,否则显⽰当前值
For Each mg In mat
m = m & mg & "|"    '循环并合并匹配结果
Next
zhengze1 = m
Else
zhengze1 = mat(0).value    '参数存储是⼀个列表形式,不能直接=号取值,必须⽤列表固有取值⽅式
End If
Else
zhengze1 = " "
End If
End With
End Function
备注,如果要提取的内容中还存在句号等其他符号时,可以在正则表达式内加上即可,如{[\w\u4e00-\u9fa5%、,。]+}注:数据⽰例在⽂件下载——VBA.slsm——⽅法2、⽅法3的⽰例在《数据》中,扩展知识在sheet9。

版权声明:本站内容均来自互联网,仅供演示用,请勿用于商业和其他非法用途。如果侵犯了您的权益请与我们联系QQ:729038198,我们将在24小时内删除。