批量提取excel单元格内字段后的内容

ser_xiaochen

lsdongjh 发表于 2019-2-15 14:35
真心无语了，楼主是 伸手党？ 给你了通用的方法，自己不知道用？

抱歉，确实不是很懂，也谢谢你了

lsdongjh

ser_xiaochen 发表于 2019-2-15 15:26
抱歉，确实不是很懂，也谢谢你了

1. 
   
2. Sub Test()
   
3.     Dim arr As Variant, lngRow As Long
   
4.     Dim strJson As String
   
5.    
   
6.     arr = Sheet1.Range("A2:B3")
   
7.    
   
8.     For lngRow = LBound(arr) To UBound(arr)
   
9.         strJson = arr(lngRow, 1)
   
10.         arr(lngRow, 2) = GetJson(strJson)
    
11.     Next
    
12.    
    
13.     Sheet1.Range("A2:B3") = arr
    
14. End Sub
    
15. Function GetJson(strJson As String) As String
    
16.    
    
17.     Dim objHTML As Object, objWin As Object
    
18.     Dim lngCount As Long, lngID As Long, strResult As String
    
19.    
    
20.     Set objHTML = CreateObject("htmlfile")
    
21.     Set objWin = objHTML.parentWindow
    
22.    
    
23.     objWin.execScript "var json = " & strJson, "JScript"
    
24.    
    
25.     lngCount = objWin.eval("json.length")
    
26.     For lngID = 0 To lngCount - 1
    
27.         strResult = strResult & " " & objWin.eval("json[" & lngID & "].text")
    
28.     Next
    
29. 
    
30.     GetJson = strResult
    
31. End Function

复制代码

ser_xiaochen

lsdongjh 发表于 2019-2-15 15:37

非常感谢，因为刚开始学，是想着希望能找多点完整的案例反推能熟悉快些，因为从基础不知道从哪开始~抱歉麻烦到你了

taller

ser_xiaochen 发表于 2019-2-15 21:54
非常感谢，因为刚开始学，是想着希望能找多点完整的案例反推能熟悉快些，因为从基础不知道从哪开始~抱歉 ...

8楼代码符合你的要求吗

ser_xiaochen

taller 发表于 2019-2-16 01:00
8楼代码符合你的要求吗

符合的，谢谢哈~我在测试延伸到其他json字段的使用

micch

正则辣么简单，我却不会

1. Sub test()
   
2.     arr = Range([a1], [a65536].End(3))
   
3.     brr = arr
   
4.     For i = 2 To UBound(arr)
   
5.         ar = Split(arr(i, 1), """}")
   
6.         s = ""
   
7.         For Each a In ar
   
8.             If InStr(a, "text") Then s = s & " " & Split(a, "text"":""")(1)
   
9.         Next
   
10.         brr(i, 1) = s
    
11.     Next
    
12.     [b1].Resize(UBound(arr)) = brr
    
13. End Sub
    

复制代码