分离

张小生

1. Sub mytest()
   
2. Dim rex As Object, mat, j
   
3. Dim ar, br(1 To 4, 1 To 10), a%, y%
   
4. ar = Range("a1:i4")
   
5. Set rex = CreateObject("vbscript.regexp")
   
6. With rex
   
7.     .Global = True
   
8.     .Pattern = "\d+\w+|\d+"
   
9.     For a = 2 To UBound(ar)
   
10.         For y = 1 To 6
    
11.             br(a, y) = ar(a, y)
    
12.             br(1, y) = ar(1, y)
    
13.         Next y
    
14.         br(a, 10) = ar(a, 9)
    
15.         br(a, 9) = ar(a, 8)
    
16.             Set mat = .Execute(ar(a, 7))
    
17.         If mat.Count <> 0 Then
    
18.             For Each j In mat '
    
19.                 br(a, 8) = j
    
20.                 br(a, 7) = Replace(ar(a, 7), j, "")
    
21.             Next j
    
22.         Else
    
23.             br(a, 8) = ""
    
24.             br(a, 7) = ar(a, 7)
    
25.         End If
    
26.     Next a
    
27.     br(1, 7) = "抬头": br(1, 8) = "税号": br(1, 9) = "联系电话": br(1, 10) = "发票签收"
    
28. End With
    
29. With Range("a8").Resize(4, 10)
    
30.     .Clear
    
31.     .NumberFormatLocal = "@"
    
32.     .Value = br
    
33.     .Borders.LineStyle = True
    
34. End With
    
35. End Sub

复制代码

风过天涯

ykcbf1100 发表于 2024-11-5 14:53
用正则分离吧

草爷如果抬头部分中含数字，怎么处理

ykcbf1100

风过天涯 发表于 2024-11-6 11:51
草爷如果抬头部分中含数字，怎么处理

那代码这样改一下。

ykcbf1100

适配第一部分也有数字的情况

ddz79101

张小生 发表于 2024-11-5 21:46

谢谢老师！运行成功

ddz79101

ykcbf1100 发表于 2024-11-6 12:40
那代码这样改一下。

谢谢老师！运行成功