188bet

manbet网

 找回密码
 注册

QQ登录

只需一步,快速开始

查看: 174|回复: 7
打印 上一主题 下一主题

[已解决]需要提取单元格数据,求大神帮助 ! 小白求救,! 谢谢

[复制链接]
跳转到指定楼层
1楼
发表于 2021-6-11 16:57 | 只看该作者 回帖奖励 |倒序浏览 |阅读模式


需要提取单元格数据,求大神帮助,
1,从表数据A行去数据.要求的数据在A6-A7,不要有符号,空格,.取完后到表结果对应的位置.
2,数据量大,VBA好像快些吧..

最佳答案
2021-6-11 22:18
Sub demo()
   Set re = CreateObject("vbscript.regexp")
   a = Sheet1.[a1].CurrentRegion
   r = 1
   For i = 1 To UBound(a)
      With re
         .Pattern = ":(.*日)(.*秒);([^:]+):([^\d]+)['\d,]+,([^,]+),.+(\d+),([\d.]+)"
         Set matches = .Execute(a(i, 1))
         With Sheet2
            r = r + 1
            For m = 0 To 6
               .Cells(r, m + 1) = matches(0).submatches(m)
            Next
         End With
      End With
   Next
End Sub

祝順心,南無阿彌陀佛!

求助.zip

9.67 KB, 下载次数: 4

分享到:  QQ好友和群QQ好友和群
收藏收藏
2楼
发表于 2021-6-11 22:18 | 只看该作者    本楼为最佳答案   
Sub demo()
   Set re = CreateObject("vbscript.regexp")
   a = Sheet1.[a1].CurrentRegion
   r = 1
   For i = 1 To UBound(a)
      With re
         .Pattern = ":(.*日)(.*秒);([^:]+):([^\d]+)['\d,]+,([^,]+),.+(\d+),([\d.]+)"
         Set matches = .Execute(a(i, 1))
         With Sheet2
            r = r + 1
            For m = 0 To 6
               .Cells(r, m + 1) = matches(0).submatches(m)
            Next
         End With
      End With
   Next
End Sub

祝順心,南無阿彌陀佛!

demo.rar

16.38 KB, 下载次数: 2

评分

参与人数 1学分 +2 收起 理由
756082@qq.com + 2

查看全部评分

3楼
 楼主| 发表于 2021-6-13 12:53 | 只看该作者
cutecpu 发表于 2021-6-11 22:18
Sub demo()
   Set re = CreateObject("vbscript.regexp")
   a = Sheet1.[a1].CurrentRegion

   .Cells(r, m + 1) = matches(0).submatches(m)  ,
   提示 : 运行时错误 ' 5'

   无效的过程调用或参数
4楼
发表于 2021-6-13 14:46 | 只看该作者
756082@qq.com 发表于 2021-6-13 12:53
.Cells(r, m + 1) = matches(0).submatches(m)  ,
   提示 : 运行时错误 ' 5'

您的 Excel 版本是?
5楼
 楼主| 发表于 2021-6-13 19:15 | 只看该作者
cutecpu 发表于 2021-6-13 14:46
您的 Excel 版本是?

office2019,
6楼
发表于 2021-6-13 19:20 | 只看该作者

您上传会出错的附件(包含资料),我来看一下!
7楼
 楼主| 发表于 2021-6-13 19:37 | 只看该作者
cutecpu 发表于 2021-6-13 19:20
您上传会出错的附件(包含资料),我来看一下!

这是附件及文本

求助,.zip

16.26 KB, 下载次数: 1

8楼
发表于 2021-6-13 20:15 | 只看该作者

注意下面红色的部份,因为您第一行拿去做筛选了,所以要从第二行开始!

Sub demo()
   Set re = CreateObject("vbscript.regexp")
   a = Sheet1.[a1].CurrentRegion
   r = 1
   For i = 2 To UBound(a)
      With re
         .Pattern = ":(.*日)(.*秒);([^:]+):([^\d]+)['\d,]+,([^,]+),.+(\d+),([\d.]+)"
         Set matches = .Execute(a(i, 1))
         With Sheet2
            r = r + 1
            For m = 0 To 6
               .Cells(r, m + 1) = matches(0).submatches(m)
            Next
         End With
      End With
   Next
End Sub


祝順心,南無阿彌陀佛!


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

本版积分规则

小黑屋|手机版|Archiver|manbet ( )

GMT+8, 2021-6-23 18:36 , Processed in 0.124800 second(s), 6 queries , Gzip On, Redis On.

Powered by X3.4

Copyright © 2001-2020, Tencent Cloud.

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