求大神看看网页源代码以Unicode 文本粘贴excel

ttbb5232

问题：

1：执行程序前，必须把鼠标点击表格数据的a1单元格，再执行程序才有数据
2：执行完数据后，最后的数据是倒数第二个网址的数据，最后一个网址数据没有执行到（这个在调试运行时感觉是执行第一个网址时，没有数据，第二个网址时执行的第一个网址的数据，所以少一个数据）

希望修改程序目的：
1：该程序数据始终粘贴在第一个单元格，前面网址数据被覆盖，希望修改程序第一个网址数据粘贴以后，第二个网址数据提行粘贴，后面以此类推，就像表格数据右面的数据一样

自己做的不行的方法

1：在txt文档复制到剪贴板后，选择表格数据单元格a1（sheets(“表格数据”).range(a1).select）(准备把a1作为变量)
     但是有这个语句后反而没有数据粘贴了
我的思路：
1：把源代码写入excel表1
2：在excel查询表1含有平均值的数据行号，然后把指定的代码复制到指定txt文档
3：把txt文档代码复制以Unicode 文本格式粘贴到excel(把excel复制到txt，再复制到excel主要是因为excel中复制不能以Unicode 文本格式粘贴)

程序在代码窗口
求大神指导，谢谢 网页源代码抓取 - 副本.zip (152.22 KB, 下载次数: 9)

2022-6-28 17:11 上传

点击文件名下载附件

ttbb523

网址依次粘贴问题已经解决

Sheets("表格数据").Range("v" & n).Select
ActiveSheet.Paste

  n = n + 9


但是有问题没有解决
就是复制粘贴内容有遗漏或者重复现象

网页源代码抓取 - 副本.zip (279.61 KB, 下载次数: 33)

2022-6-29 13:21 上传

点击文件名下载附件

eennoo

1. Sub 你把网页的那些input都贴到表格上不觉得很卡的吗()
   
2. Dim HTML, TD, result, TABLE, TB_TR, TB_TD, TB_TRS, TB_TDS, dwRow, dwCol
   
3. Dim dwSumRow, dwSumCol
   
4. a = [{"平均值","最高值","最低值","离散值"}]
   
5. On Error Resume Next
   
6. arr = Sheets("欧赔地址").Range("e1:e14")
   
7. Set http = CreateObject("Msxml2.XMLHTTP")
   
8. Set HTML = CreateObject("HTMLFILE")
   
9. 
   
10. ReDim result(1 To Cells.Rows.Count, 1 To 20)
    
11. 
    
12. For Each szUrl In arr
    
13. http.Open "GET", szUrl, False
    
14. http.send
    
15. If http.readyState = 4 Then
    
16. szHttpText = StrConv(http.responseBody, vbUnicode)
    
17. szHttpText = Mid(szHttpText, InStr(szHttpText, "id=""table_btm"""))
    
18. szHttpText = "<div " & Left(szHttpText, InStr(szHttpText, "<div class=""odds_msg2""") - 2)
    
19. 
    
20. HTML.write szHttpText
    
21. 
    
22. For Each TR In HTML.getElementsByTagName("tr")
    
23. If TR.getAttribute("xls") Then
    
24. k = k + 1 '引数
    
25.     For Each TABLE In TR.getElementsByTagName("table")
    
26.         If TABLE.className = "pl_table_data" Then
    
27.         
    
28.             '表格内容
    
29.             Set TB_TRS = TABLE.getElementsByTagName("tr") '行集合
    
30.             For dwRow = 0 To TB_TRS.Length - 1
    
31.                 Set TB_TDS = TB_TRS(dwRow).getElementsByTagName("td") '列集合
    
32.                  For dwCol = 0 To TB_TDS.Length - 1 '行
    
33.                     If TB_TDS(dwCol).innerText <> "" Then
    
34.                         result(dwRow + dwSumRow + 1, dwCol + dwSumCol + 2) = TB_TDS(dwCol).innerText '存放结果内容
    
35.                     End If
    
36.                  Next
    
37.             Next
    
38.             
    
39. 
    
40.             dwSumCol = dwSumCol + dwCol
    
41.             
    
42.         End If
    
43.     Next
    
44.     '归位
    
45.    
    
46. dwSumCol = 0
    
47. dwSumRow = dwSumRow + 2
    
48. result(dwSumRow - 1, 1) = a(k)
    
49. 
    
50. End If
    
51. Next
    
52.     k = 0
    
53.     HTML.Close
    
54. End If
    
55. dwSumRow = dwSumRow + 1
    
56. Next
    
57. 
    
58. [A1].Resize(dwSumRow, 20) = result
    
59. End Sub

复制代码