这类拆分数据需要怎么处理比较快，请各位老师进来看一下

antique_star

henry6 发表于 2021-12-13 16:05
楼主是不是要的这种结果，VBA+正则表达式

大哥，你是不是忘了上传附件啊？
否则岂不有卖弄之嫌？

消灭零公里

试试PQ？

antique_star

借你的案例，硬逼着自己去学习了一下正则，
实在是能力有限，只能解决4个，有一个解决不了。
代码如下：

1. Sub Test() '号字的UNICODE：\u53f7
   
2.   With ActiveSheet
   
3.     R = .Cells(10000, 2).End(xlUp).Row
   
4.     Dim Target_Data()
   
5.     Target_Data = .[B3].Resize(R - 2).Value
   
6.   End With
   
7.   
   
8.   Dim MyReg As Object
   
9.   Set MyReg = CreateObject("VBScript.Regexp")
   
10.   Dim My_Matches As Object, My_Match As Object
    
11.   Dim Temp_Str As String
    
12.   For I = 1 To UBound(Target_Data)
    
13.     With MyReg
    
14.      .Global = True
    
15.      .Pattern = "[\u4e00-\u9fa5]*\d*\u53f7+[\u4e00-\u9fa5]*\d*-*\d*"
    
16.       Set My_Matches = .Execute(Target_Data(I, 1))
    
17.     End With
    
18.     For Each My_Match In My_Matches
    
19.       Temp_Str = Temp_Str & My_Match & ";"
    
20.     Next
    
21.     If Right(Temp_Str, 1) = ";" Then Temp_Str = Left(Temp_Str, Len(Temp_Str) - 1)
    
22.     ActiveSheet.Cells(I + 2, 3).Value = Temp_Str
    
23.     Temp_Str = ""
    
24.   Next
    
25.   MsgBox "执行完毕！", vbOKOnly + vbInformation, "乐天工作室：温馨提示！"
    
26.   
    
27. End Sub
    

复制代码

运行效果如图，只能解决4个，第5个有冲突，想破脑袋也想不出排除规则：

因为自己是一边摸索，一边测试，
不太会正则的窍门，只能遵从正则的基本语法，
所以规则的表述自己都觉得像懒婆娘的裹脚布——又臭又长："[\u4e00-\u9fa5]*\d*\u53f7+[\u4e00-\u9fa5]*\d*-*\d*"
顺便跟你解释一下吧：
[\u4e00-\u9fa5]代表所有的中文
后面跟一个星号，表述中文出现的次数是0至无限个，如果是+号表示至少出现1次以上
\u53f7是号字对应的UNICODE，这个网上可以查。
\d表示数字
其他没什么。
附上网上找的正则语法基础


兄弟不妨自己学习一下吧。

你的这个案例是我第一次使用正则，
虽然不太会，
但感觉正则在数据加工领域功能相当强大。
速度快！多样性组合的妙用。

楼下似乎有人解决了，
可惜没上传附件。
期待高人的指点，
我也同样需要提高。

其他不说了，见附件。

夏天的风shh4695

以下代码可以解决你的问题，请参考！

Dim i As Integer
Set reg = CreateObject("VBScript.Regexp")
rownumber = Cells(Rows.Count, "G").End(xlUp).Row
Sheets("sheet1").Range("H:H").Clear

With reg
    .Global = True
    .Pattern = "[一-龢]+\d*-?\d+[号|\d+]"
   
    For i = 2 To rownumber
        结果 = ""
        Set rst = .Execute(Sheets("sheet1").Range("G" & i))
        For Each s In rst
            结果 = 结果 & ";" & s
        Next s
        结果 = Mid(结果, 2, Len(结果) - 1)
        If 结果 <> "" Then
            Range("G" & i).Offset(0, 1) = 结果
        Else
           Range("G" & i).Offset(0, 1) = "未匹配到"
        End If
    Next i
End With

End Sub

夏天的风shh4695

以下代码可以解决你的问题，请参考！

Sub 数据处理()
Dim i As Integer
Set reg = CreateObject("VBScript.Regexp")
rownumber = Cells(Rows.Count, "G").End(xlUp).Row
Sheets("sheet1").Range("H:H").Clear
With reg
    .Global = True
    .Pattern = "[一-龢]+\d*-?\d+[号|\d+]"
   
    For i = 2 To rownumber
        结果 = ""
        Set rst = .Execute(Sheets("sheet1").Range("G" & i))
        For Each s In rst
            结果 = 结果 & ";" & s
        Next s
        If 结果 <> "" Then
            结果 = Mid(结果, 2, Len(结果) - 1)
            Range("G" & i).Offset(0, 1) = 结果
        Else
           Range("G" & i).Offset(0, 1) = "未匹配到"
        End If
    Next i
End With
End Sub