正则提取发票号，专票号，税号

3190496160

水平有限，不会正则表达式，遇到一个棘手的问题，我自己写的代码没办法完全准确的提取出来，目前B列就是我的代码提取的结果，不完全对，麻烦会正则的朋友帮忙看看，能不能实现需要的效果，
需求：
根据A列的数据，把A列单元格中的发票号，专票号，税号，提取到对应行的B列中，
麻烦路过的朋友帮忙看看，有其他办法能解决也行，
提取发票号专票号税号.rar (77.02 KB, 下载次数: 48)

2022-10-8 14:57 上传

点击文件名下载附件

longming3

这个不一定要正则，直接split（split（第1列，"发票号：")(1),"，")(0)，就把发票号提取出来了，税号在示例中没看到。
非要正则，只有等高手出招了

gufengaoyue

你用这个公式试试。

1. Function getTax(Rng As Range)
   
2.     With CreateObject("VBSCRIPT.REGEXP")
   
3.         .Global = True         '设置全局可用
   
4.         .Pattern = "(税号|专票号|发票号)[:：]?([0-9\-]+([、，,/]*[0-9\-])*)"
   
5.         Set Matches = .Execute(Rng.Value)
   
6.     End With
   
7.     For Each Match In Matches
   
8.         s = s & "、" & Match.submatches(1)
   
9.     Next
   
10. getTax = Mid(s, 2)
    
11. End Function

复制代码

zpy2

select *,regexp2('(专票号|发票号|税号)：?(\d+)',字符串,2) 新 from 基础正则表达式拆分之专票号;

ZHLK

Sub demo()
On Error Resume Next
arr = Range("a2:a1009")
n = UBound(arr)
Dim brr(2 To 1009)
a = 2
For i = 1 To n - 1
    If InStr(arr(i, 1), "发票号") > 0 Then
        str1 = Replace(Replace(Split(Split(arr(i, 1), "发票号")(1), "，")(0), "）", ""), "：", "")
        If str1 <> "" Then
            brr(a) = brr(a) & "发票号：" & str1
        Else
            brr(a) = ""
        End If
    ElseIf InStr(arr(i, 1), "专票号") Then
        str1 = Replace(Replace(Split(Split(arr(i, 1), "专票号")(1), "，")(0), "）", ""), "：", "")
        If str1 <> "" Then
            brr(a) = brr(a) & "专票号：" & str1
        Else
            brr(a) = ""
        End If
    ElseIf InStr(arr(i, 1), "税号") Then
        str1 = Replace(Replace(Split(Split(arr(i, 1), "税号")(1), "，")(0), "）", ""), "：", "")
        If str1 <> "" Then
            brr(a) = brr(a) & "税号：" & str1
        Else
            brr(a) = ""
        End If
    End If
    a = a + 1
    str1 = ""
Next

For i = 2 To 1009
    Cells(i, 3) = brr(i)
Next

End Sub

wodewan

参与一下，各式各样的要搞全了得仔细检查，哈哈，上面各种版本都有了，来个WPSJS版本

3190496160

gufengaoyue 发表于 2022-10-8 15:54
你用这个公式试试。

佩服，真是高手啊，真的实现了效果了，
非常感谢您的无私，祝工作顺利，天天开心
就是有个不足，因为拆分出来的结果还要用到其他代码中，能不能不用自定义函数，直接用代码写入单元格区域内？麻烦帮忙再看看，先谢过了

3190496160

ZHLK 发表于 2022-10-8 16:32
Sub demo()
On Error Resume Next
arr = Range("a2:a1009")

非常感谢你的无私付出，大部分实现了效果，但是，还有一些特殊的没有完全提取出来，比如：
535行，这个情况，就只提取了第一个
陈卫华报销10月金地(集团)股份有限公司服务任务分包费HT09201812-7004，专票号：27308111-13，27308108，14151638-42，14097974，税额5377.35元,供应商:深圳市金信捷科技有限公司

小象啊啊

请参考附件。

gufengaoyue

3190496160 发表于 2022-10-8 16:58
佩服，真是高手啊，真的实现了效果了，
非常感谢您的无私，祝工作顺利，天天开心
就是有个不足，因为拆 ...

那再加一个就可以了。

1. Function getTax(Txt)
   
2.     With CreateObject("VBSCRIPT.REGEXP")
   
3.         .Global = True
   
4.         .Pattern = "(税号|专票号|发票号)[:：]?([0-9\-]+([、，,/]*[0-9\-])*)"
   
5.         Set Matches = .Execute(Txt)
   
6.     End With
   
7.     For Each Match In Matches
   
8.         s = s & "、" & Match.submatches(1)
   
9.     Next
   
10. getTax = Mid(s, 2)
    
11. End Function
    
12. 
    
13. Sub get_Tax()
    
14. Dim arr, brr
    
15. arr = Application.Transpose([a2].Resize(ActiveSheet.UsedRange.Rows.Count - 2))
    
16. ReDim brr(1 To UBound(arr))
    
17. For a = 1 To UBound(arr)
    
18.     brr(a) = getTax(arr(a))
    
19. Next
    
20. [b2].Resize(UBound(arr)) = Application.Transpose(brr)
    
21. End Sub
    

复制代码