ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

新浪微博登陆

只需一步, 快速开始

   
高效办公必会的Office实战技巧 永久免费,网表让Excel秒变数据库 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
Excel不给力? 何不试试FoxTable! 国内首部Excel函数公式学习大典 职场充电黑科技, Office微视频教程 免费下载Excel行业应用视频
300集Office 2010微视频教程 Tableau-数据可视化工具 突破Excel限制,用活字格提高效率 12门Excel免费公开课任你学
你的Excel 2010实战技巧学习锦囊 欲罢不能, 过目难忘的 Office 新界面 免费的Excel考勤计算系统
查看: 479|回复: 16

[已解决] 单元格中的数字分别提取出来

[复制链接]

TA的精华主题

TA的得分主题

发表于 2017-4-21 10:53 | 显示全部楼层 |阅读模式
可不可以把一个单元格中的数字分别提取出来,
比如:A1单元格   支3920终00000001好50915274       有三个数字   分别可以 在B1单元格提取3920   C1单元格提取00000001  D1单元格提取50915274     
如果还有第四个数字,那就放在E1  以此类推;
详见附件表格,因为单元格比较乱,感觉上没有统一的逻辑,尽量可以把大部分的匹配出来,公式好像做不了了,麻烦高手帮忙写个宏。
谢谢高手们!

工作簿1.rar

8.13 KB, 下载次数: 36

TA的精华主题

TA的得分主题

发表于 2017-4-21 11:13 | 显示全部楼层
这种问题用正则最合适了,当然,用循环把数字替换为空格也可以...............................................

TA的精华主题

TA的得分主题

发表于 2017-4-21 11:31 | 显示全部楼层
小花鹿 发表于 2017-4-21 11:13
这种问题用正则最合适了,当然,用循环把数字替换为空格也可以.......................................... ...


Sub aa()

Dim rz As Object
Dim 数据源 As String, Item As Double '声明变量
For a = 2 To Cells(Rows.Count, 1).End(3).Row
数据源 = Range("a" & a)
With CreateObject("VBSCRIPT.REGEXP")  '引用正则表达式
  .Global = True     '全局匹配
  .Pattern = "[0-9]{4,}"  '指定匹配条件
  Set Matches = .Execute(数据源)  '执行匹配
  For Each Match In Matches    '遍历匹配的结果
    b = b + 1
    Cells(a, b + 1) = Match
  Next
  b = 0
  Set Matches = Nothing
End With
Next

End Sub

试一试吧,有问题可以联系QQ158456166

评分

参与人数 1鲜花 +2 收起 理由
LMY123 + 2 感谢帮助

查看全部评分

TA的精华主题

TA的得分主题

发表于 2017-4-21 11:31 | 显示全部楼层
这种还真使用正则最合适不过,可惜我只能看看,帮不了,不懂正则

TA的精华主题

TA的得分主题

发表于 2017-4-21 11:32 | 显示全部楼层
Sub aa()

Dim rz As Object
Dim 数据源 As String, Item As Double '声明变量
For a = 2 To Cells(Rows.Count, 1).End(3).Row
数据源 = Range("a" & a)
With CreateObject("VBSCRIPT.REGEXP")  '引用正则表达式
  .Global = True     '全局匹配
  .Pattern = "[0-9]{4,}"  '指定匹配条件
  Set Matches = .Execute(数据源)  '执行匹配
  For Each Match In Matches    '遍历匹配的结果
    b = b + 1
     Cells(a, b + 1) = Match
   Next
   b = 0
   Set Matches = Nothing
End With
Next

End Sub

试一试吧,有问题可以联系QQ158456166

TA的精华主题

TA的得分主题

发表于 2017-4-21 11:58 | 显示全部楼层
Sub aa()
Application.ScreenUpdating = False

Dim rz As Object
Dim 数据源 As String, Item As Double '声明变量
For a = 2 To Cells(Rows.Count, 1).End(3).Row
数据源 = Range("a" & a)
With CreateObject("VBSCRIPT.REGEXP")  '引用正则表达式
  .Global = True     '全局匹配
  .Pattern = "[0-9]{1,}[^(\.|/)][0-9]\b"  '指定匹配条件
  Set Matches = .Execute(数据源)  '执行匹配
  For Each Match In Matches    '遍历匹配的结果
    b = b + 1
    Cells(a, b + 1) = Match
  Next
  b = 0
  Set Matches = Nothing
End With
Next
Application.ScreenUpdating = True

End Sub

这个匹配更好,把一些乱结果除去了。

TA的精华主题

TA的得分主题

发表于 2017-4-21 12:36 | 显示全部楼层
非正则方法路过
  1. Sub 数字()
  2. Dim num, i, j, N, M, CV
  3. For i = 2 To Cells(65536, 1).End(xlUp).Row
  4. CV = "@" & Cells(i, 1) & "@"
  5. M = 0
  6. N = 2
  7. num = ""
  8. For j = 1 To Len(CV)
  9. If IsNumeric(Mid(CV, j, 1)) Then
  10. M = M + 1
  11. num = num & Mid(CV, j, 1)
  12. GoTo ST
  13. ElseIf M > 3 Then
  14. Cells(i, N) = num
  15. N = N + 1
  16. End If
  17. num = ""
  18. M = 0
  19. ST:
  20. Next
  21. Next
  22. End Sub
复制代码

评分

参与人数 1鲜花 +2 收起 理由
LMY123 + 2 感谢帮助

查看全部评分

TA的精华主题

TA的得分主题

发表于 2017-4-21 13:10 | 显示全部楼层
3.29要匹配吗?....................................................................................................

TA的精华主题

TA的得分主题

发表于 2017-4-21 13:30 | 显示全部楼层
本帖最后由 lsdongjh 于 2017-4-21 13:33 编辑

用正则最简单,见代码:
  1. Sub Test()
  2.     Application.ScreenUpdating = False
  3.     Application.Cursor = xlWait
  4.    
  5.     Dim lngRows As Long, lngR As Long
  6.     Dim strTemp As String
  7.     Dim strR As Variant
  8.    
  9.     lngRows = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
  10.    
  11.     For lngR = 2 To lngRows
  12.         strTemp = Sheet1.Range("A" & lngR).Value2
  13.         strR = GetDigit(strTemp)
  14.         If IsEmpty(strR) = False Then Sheet1.Range("B" & lngR).Resize(1, UBound(strR)) = strR
  15.     Next
  16.    
  17.     Application.ScreenUpdating = True
  18.     Application.Cursor = xlDefault
  19. End Sub

  20. Function GetDigit(strValue As String) As Variant
  21.     Dim objReg As Object
  22.     Dim objMatchs As Object, objMatch As Object
  23.     Dim strPat As String
  24.     Dim strResult() As String  '字符型String可以得到[00001],如果想直接得到数字,可以定义为长整型Long
  25.     Dim intIndex As Integer
  26.    
  27.     strPat = "\d+\.*\d*"
  28.    
  29.     Set objReg = CreateObject("VBScript.RegExp")
  30.     With objReg
  31.         .Global = True
  32.         .Pattern = strPat
  33.         Set objMatchs = .Execute(strValue)
  34.         intIndex = objMatchs.Count
  35.         If intIndex > 0 Then
  36.             ReDim strResult(1 To objMatchs.Count)
  37.             intIndex = 0
  38.             For Each objMatch In objMatchs
  39.                    intIndex = intIndex + 1
  40.                    strResult(intIndex) = objMatch
  41.             Next
  42.             GetDigit = strResult
  43.         End If
  44.     End With
  45.    
  46. End Function

复制代码

评分

参与人数 1鲜花 +2 收起 理由
LMY123 + 2 感谢帮助

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2017-4-21 14:57 | 显示全部楼层
梁三刀木 发表于 2017-4-21 11:58
Sub aa()
Application.ScreenUpdating = False

感谢,太感谢了,崇拜之情如滔滔江水
也感谢楼上的大家帮忙
您需要登录后才可以回帖 登录 | 免费注册 新浪微博登陆

本版积分规则

关闭

最新热点上一条 /1 下一条

关注官方微信,每天坐享新鲜教程

手机版|关于我们|联系我们|ExcelHome   

GMT+8, 2017-9-21 20:22 , Processed in 0.101300 second(s), 24 queries , Gzip On, MemCache On.

Powered by Discuz! X3.3

© 2001-2017 Wooffice Inc.

   

沪公网安备 31011702000001号 沪ICP备11019229号

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:徐怀玉律师 李志群律师

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