如何处理这样一些文本

Datous

有一些特殊的文本数据，都是系统导出
数据格式如下：

数据

08进库 40

1015领入 40

678-1再领 39

代领 41

Y-6终结 43

纯色7586-T领 44

领入 43

希望转换为如下形式，三个字段：
字段3，是数字，可能是2位数字或3位数字
字段2，连续的几个汉字，最多10个
字段1，连续的非汉字（包括数字或者标点符号或者英文），也有可能前面有连续的汉字

模拟结果
字段1	字段2	字段3
08	进库	40
1015	领入	40
678-1	再领	39
	代领	41
Y-6	终结	43
纯色7586-T	领	44
	领入	43

想要使用正则实现。
附件：
20151128-.rar (6.3 KB, 下载次数: 15)

2015-11-28 11:14 上传

点击文件名下载附件

小花鹿

Sub test()
Dim reg, s, i&
Set reg = CreateObject("vbscript.regexp")
For i = 3 To 9
    s = StrReverse(Cells(i, 1))
    reg.Pattern = "\d+"
    Cells(i, 4) = StrReverse(reg.Execute(s)(0))
    s = reg.Replace(s, "")
    reg.Pattern = "[一-龥]+"
    Cells(i, 3) = StrReverse(reg.Execute(s)(0))
    s = reg.Replace(s, "")
    Cells(i, 2) = Trim(StrReverse(s))
Next i
End Sub

袁振涛

1.     Dim Arr, Arr2, oReg As Object, oMatchCollection As Object
   
2.     Application.ScreenUpdating = False
   
3.     Set oReg = CreateObject("VBSCRIPT.REGEXP")
   
4.     oReg.Pattern = "^(.*?)([\u4e00-\u9fff\uf900-\ufa2d]{1,10})\s*(\d{2,3})$"
   
5.     Arr = [a3].Resize([a1].CurrentRegion.Rows.Count - 2)
   
6.     ReDim Arr2(1 To UBound(Arr), 1 To 3)
   
7.     For i = 1 To UBound(Arr)
   
8.         Set oMatchCollection = oReg.Execute(Arr(i, 1))
   
9.         If oMatchCollection.Count > 0 Then
   
10.             Arr2(i, 1) = oMatchCollection(0).submatches(0)
    
11.             Arr2(i, 2) = oMatchCollection(0).submatches(1)
    
12.             Arr2(i, 3) = oMatchCollection(0).submatches(2)
    
13.         End If
    
14.     Next
    
15.     [b3].Resize(UBound(Arr), 3) = Arr2
    
16.     Application.ScreenUpdating = True

复制代码

袁振涛

欢迎提供更多测试字段

小花鹿

Sub test()
Dim reg, i&
Set reg = CreateObject("vbscript.regexp")
reg.Pattern = "(.*?)([一-龥]+)\s*(\d+)$"
For i = 3 To 9
    Cells(i, 2) = reg.Execute(Cells(i, 1))(0).submatches(0)
    Cells(i, 3) = reg.Execute(Cells(i, 1))(0).submatches(1)
    Cells(i, 4) = reg.Execute(Cells(i, 1))(0).submatches(2)
Next i
End Sub