[已解决]求帮忙提取数据

hadesqu

请大神帮忙指导用VBA 提取需要的数据，将A列中的数据提取到G/H 列，我在附件中聚了例子，请帮忙看下~谢谢~~~

最佳答案

月排行榜 / 总排行榜

grf1973

2017-7-3 16:02

1. Sub tt()
   
2.     arr = Range("a1:a" & [a65536].End(3).Row)
   
3.     ReDim brr(1 To UBound(arr), 1 To 2)
   
4.     With CreateObject("vbscript.regexp")
   
5.         .Global = True
   
6.         .Pattern = "(\w+_\d+)(?=').+?(J\d+\.?\d+)"
   
7.         For i = 1 To UBound(arr) Step 7
   
8.             s = arr(i, 1) & arr(i + 1, 1) & arr(i + 2, 1) & arr(i + 3, 1) & arr(i + 4, 1)
   
9.             n = n + 1
   
10.             brr(n, 1) = .Execute(s)(0).submatches(0)
    
11.             brr(n, 2) = .Execute(s)(0).submatches(1)
    
12.         Next
    
13.      End With
    
14.      [g8].Resize(n, 2) = brr
    
15. End Sub
    

复制代码

跳转到最佳答案楼层

小花鹿

用正则表达式比较方便........................

hadesqu

小花鹿 发表于 2017-7-3 11:09
用正则表达式比较方便........................

怎么玩呢？求指点，只要能解决都OK~~

QCW911

<  ([\s\S]+?)' >[\s\S]+?(J\d+.\d+)

  匹配组1(行1:列4,长度:10): temst_9009
  匹配组2(行5:列1,长度:7): J127.68
----------------------------------------------------------------------
  匹配组1(行7:列4,长度:10): temst_3109
  匹配组2(行11:列1,长度:7): J127.58
----------------------------------------------------------------------
  匹配组1(行13:列4,长度:10): demst_9019
  匹配组2(行17:列1,长度:7): J127.48
----------------------------------------------------------------------
  匹配组1(行19:列4,长度:9): temst_109
  匹配组2(行23:列1,长度:7): J127.78
----------------------------------------------------------------------
  匹配组1(行26:列4,长度:10): temst_9019
  匹配组2(行30:列1,长度:7): J127.61

hadesqu

QCW911 发表于 2017-7-3 12:06
<  ([\s\S]+?)' >[\s\S]+?(J\d+.\d+)

  匹配组1(行1:列4,长度:10): temst_9009

抱歉，我没看懂，这个怎么玩的呢?能给个文本看看嘛

hadesqu

自己顶一顶，有没有来帮忙的呀

QCW911

正则，里面不是出来了吗？
答案都告诉你了 +q57726980

hadesqu

QCW911 发表于 2017-7-3 14:22
正则，里面不是出来了吗？
答案都告诉你了 +q57726980

我加你Q了，能发个处理好的excel 给我吗？

grf1973

1. Sub tt()
   
2.     arr = Range("a1:a" & [a65536].End(3).Row)
   
3.     ReDim brr(1 To UBound(arr), 1 To 2)
   
4.     With CreateObject("vbscript.regexp")
   
5.         .Global = True
   
6.         .Pattern = "(\w+_\d+)(?=').+?(J\d+\.?\d+)"
   
7.         For i = 1 To UBound(arr) Step 7
   
8.             s = arr(i, 1) & arr(i + 1, 1) & arr(i + 2, 1) & arr(i + 3, 1) & arr(i + 4, 1)
   
9.             n = n + 1
   
10.             brr(n, 1) = .Execute(s)(0).submatches(0)
    
11.             brr(n, 2) = .Execute(s)(0).submatches(1)
    
12.         Next
    
13.      End With
    
14.      [g8].Resize(n, 2) = brr
    
15. End Sub
    

复制代码