Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 7761|回复: 9

用正则表达式提取数字

[复制链接]
发表于 2014-1-14 21:46 | 显示全部楼层 |阅读模式
用正则表达式提取数字

新建 Microsoft Office Excel Workbook.rar

1.96 KB, 下载次数: 46

excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
发表于 2014-1-14 21:59 | 显示全部楼层
请楼主测试:
  1. Sub 正则()
  2.     Dim ar, re, regex As Object
  3.     Dim i As Integer, matches
  4.     Sheets(1).Range("C1:C65536").ClearContents
  5.     ar = Sheets(1).Range("A1").CurrentRegion
  6.     Set regex = CreateObject("VBScript.Regexp")
  7.     ReDim re(1 To UBound(ar), 1 To 1)
  8.     regex.Global = True
  9.     regex.Pattern = "\d+"
  10.     For i = 1 To UBound(ar)
  11.         Set matches = regex.Execute(ar(i, 1))
  12.         For Each m In matches
  13.             re(i, 1) = re(i, 1) & m.Value
  14.         Next
  15.     Next i
  16.     Sheets(1).[b1].Resize(UBound(re)) = re
  17. End Sub
复制代码
回复

使用道具 举报

发表于 2014-1-14 22:03 | 显示全部楼层
  1. Sub test()
  2.     Dim arr
  3.     Dim k%, m, mat
  4.     arr = Range("a1:b" & Cells(Rows.Count, 1).End(3).Row)
  5.     For k = 1 To UBound(arr)
  6.         With CreateObject("vbscript.regexp")
  7.             .Global = True
  8.             .Pattern = "\d+"

  9.             Set mat = .Execute(arr(k, 1))
  10.             For Each m In mat
  11.                 arr(k, 2) = m
  12.             Next
  13.         End With
  14.     Next k
  15.     [a1].Resize(UBound(arr), 2) = arr
  16. End Sub
复制代码

点评

REPLACE方法,确实好用,借机学习了 ^_^  发表于 2014-1-14 23:05
用REPLACE试试啊,别总用EXECUTE得到对象集合再循环,效率低。  发表于 2014-1-14 22:46
回复

使用道具 举报

发表于 2014-1-14 22:26 | 显示全部楼层
本帖最后由 苗凱 于 2014-1-15 08:28 编辑

Sub 提取数字()
    Dim arr, i, mrow, s, t
    Dim rex As Object
    Dim exe As Object
   Set rex = CreateObject("vbscript.regexp")
    mrow = Sheet1.Cells(A65536).End(xlUp)
    arr = Sheet1.Range("A1,b" & mrow).Value
    For s = 1 To UBound(arr)
   With CreateObject("vbscript.regexp")
    .Global = True
    .Pattern = "\d+"
    Set exe = rex.Execute(arr(s, 1))
        For Each t In exe
      arr(s, 2) = t
           Next
           End With
           Next s
           [b1].Resize(UBound(arr), 1) = arr
End Sub

回复

使用道具 举报

发表于 2014-1-14 23:03 | 显示全部楼层
花花有空也指导下我呀  {:2512:}{:2512:}
现抄一个:
  1. Sub 正则2()
  2.     Dim ar, re
  3.     Dim i As Integer, matches
  4.     Sheets(1).Range("C1:C65536").ClearContents
  5.     ar = Sheets(1).Range("A1").CurrentRegion
  6.     ReDim re(1 To UBound(ar), 1 To 1)
  7.     With CreateObject("VBScript.Regexp")
  8.         .Global = True
  9.         .Pattern = "\D"
  10.         For i = 1 To UBound(ar)
  11.             re(i, 1) = .Replace(ar(i, 1), "")
  12.         Next i
  13.     End With
  14.     Sheets(1).[b1].Resize(UBound(re)) = re
  15. End Sub
复制代码
回复

使用道具 举报

发表于 2014-1-14 23:13 | 显示全部楼层
本帖最后由 戒不掉心中的瘾 于 2014-1-15 00:04 编辑

Sub test()
Dim arr, brr(), reg, i, str, n, x
Set reg = CreateObject("vbscript.regexp")
arr = Range("a1:a" & [a65536].End(xlUp).Row)
For i = LBound(arr) To UBound(arr)
    With reg
        .Global = True
        .Pattern = "\d+"
        Set str = .Execute(arr(i, 1))
            x = x + 1
            ReDim Preserve brr(1 To x)
            If str.Count > 1 Then
                brr(x) = Val(str(0)) * Val(str(1))
            ElseIf str.Count > 0 Then
                .Pattern = "\d+[g|G]\b"
                Set str = .Execute(arr(i, 1))
                If str.Count > 0 Then brr(x) = Val(str(0))
            End If
    End With
Next
Range("b1").Resize(UBound(brr), 1) = Application.Transpose(brr)
End Sub


回复

使用道具 举报

发表于 2014-1-14 23:30 | 显示全部楼层
看我超强的【正则提取字符】多功能自定义函数:

正则提取字符的超强大多功能自定义函数.rar

9.81 KB, 下载次数: 87

评分

参与人数 3 +25 收起 理由
yunnl + 1 很给力
戒不掉心中的瘾 + 3 很给力!
CheryBTL + 21 很给力!

查看全部评分

回复

使用道具 举报

发表于 2014-1-15 20:30 | 显示全部楼层
都没有考虑小数,实际意义不大,最好用自定义函数提取数字(包括小数)。
回复

使用道具 举报

发表于 2014-1-15 20:41 | 显示全部楼层
叶公指导的对
  1. Sub test()
  2.     Dim arr, k%, i%
  3.     arr = Range("a1").CurrentRegion
  4.     With CreateObject("vbscript.regexp")
  5.         .Global = True
  6.         .Pattern = "[^\d]"
  7.         For k = 1 To UBound(arr)
  8.             If .test(arr(k, 1)) Then arr(k, 1) = .Replace(arr(k, 1), "")
  9.         Next k
  10.     End With
  11.     Range("b1").Resize(UBound(arr), 1) = arr
  12. End Sub
复制代码
回复

使用道具 举报

发表于 2017-10-18 15:45 | 显示全部楼层
学习
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-29 22:51 , Processed in 0.550963 second(s), 17 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表