方法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("vbscript.regexp")
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("vbscript.regexp")
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("vbscript.regexp")
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
备注,如果要提取的内容中还存在句号等其他符号时,可以在正则表达式内加上即可,如{[wu4e00-u9fa5%、,。]+}
注:数据示例在文件下载——VBA.slsm——方法2、方法3的示例在《数据》中,扩展知识在sheet9。