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

756082@qq.com

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

最佳答案

月排行榜 / 总排行榜

cutecpu

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

祝順心，南無阿彌陀佛！

跳转到最佳答案楼层

cutecpu

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

祝順心，南無阿彌陀佛！

756082@qq.com

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'

   无效的过程调用或参数

cutecpu

756082@qq.com 发表于 2021-6-13 12:53
.Cells(r, m + 1) = matches(0).submatches(m)  ,
   提示 : 运行时错误 ' 5'

您的 Excel 版本是？

756082@qq.com

cutecpu 发表于 2021-6-13 14:46
您的 Excel 版本是？

office2019，

cutecpu

756082@qq.com 发表于 2021-6-13 19:15
office2019，

您上传会出错的附件(包含资料)，我来看一下！

756082@qq.com

cutecpu 发表于 2021-6-13 19:20
您上传会出错的附件(包含资料)，我来看一下！

这是附件及文本

cutecpu

756082@qq.com 发表于 2021-6-13 19:37
这是附件及文本

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

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


祝順心，南無阿彌陀佛！