方法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
備注,如果要提取的內容中還存在句號等其他符號時,可以在正則表達式內加上即可,如{[\w\u4e00-\u9fa5%、,。]+}
注:數據示例在文件下載——VBA.slsm——方法2、方法3的示例在《數據》中,擴展知識在sheet9。