获取长江有色金属网及上海有色金属网金属价格

YDH318 · 发表于 2020-9-7 17:49

最新网页 https://www.ccmn.cn/cjxh.shtml，如何将该页面的金属价格表格读取到EXCEL工作表中

同样的https://www.smm.cn/如何将该页面的金属价格表格读取到EXCEL工作表中

苏悉 · 发表于 2020-9-9 09:26

如果通过Excel数据选项卡中的获取网页数据提取不出来的话，可以通过分析网页采用爬虫技术将网页表格爬取出来。

此用户被禁言 · 发表于 2020-9-9 15:54

自网站数据来自这里：https://www.ccmn.cn/history_data/cjxh.html

felix301 · 发表于 2023-7-12 11:15

Sub 提取长江金属网的数据()
On Error Resume Next
Sheets("有色金属").Select
Dim strText$, sp As Shape
With CreateObject("msxml2.xmlhttp")
      .Open "GET", "https://www.ccmn.cn/history_data/cjxh.html", False
      .send
      Do While .readystate <> 4
         DoEvents
      Loop
      strText = .responseText
End With
Set dm = CreateObject("Htmlfile"): Set w = dm.parentWindow
dm.body.innerHTML = strText
strText = Split(Split(strText, "<th>日期</th>")(1), "</tbody>")(0)
arr = Split(strText, "          <tr>")
A = UBound(arr)
ReDim brr(1 To A, 1 To 7)
For i = 1 To A
      str_i = Split(arr(i), "             ")
      For j = 1 To 5
         brr(i, j) = Split(Split((str_i(j)), "<td>")(1), "</td>")(0)
      Next j
      brr(i, 6) = Split(Split((str_i(UBound(str_i) - 1)), ">")(1), "</")(0)
      brr(i, 7) = CDate(Split(Split((str_i(UBound(str_i))), "<td>")(1), "</td>")(0))
Next i
UserForm4.Caption = "当前数据网抓于--长江有色金属网"
With UserForm4.ListView1
      .ColumnHeaders.Add , , "序号", 30, lvwColumnLeft
      .ColumnHeaders.Add , , "规格", 100, lvwColumnLeft
      .ColumnHeaders.Add , , "最低", 42, lvwColumnCenter
      .ColumnHeaders.Add , , "最高", 42, lvwColumnCenter
      .ColumnHeaders.Add , , "均价", 42, lvwColumnCenter
      .ColumnHeaders.Add , , "涨跌", 42, lvwColumnCenter
      .ColumnHeaders.Add , , "日期", 65, lvwColumnCenter
      .View = lvwReport
      .Gridlines = True
      ENDCOL = Cells.Find("*", Cells(1, 1), xlValues, xlWhole, xlByColumns, xlPrevious).Column
      For i = 1 To UBound(brr)
         Set Itm = .ListItems.Add()
         Itm.Text = brr(i, 1)
         For c = 2 To 7
            Itm.SubItems(c - 1) = brr(i, c)
         Next c

         Sheets("有色金属").Cells(i + 1, 1) = brr(i, 2)
         Set k = Sheets("有色金属").Cells.Find(brr(i, 7))
         brr(i + 1, 7) = brr(i, 7)
         If k Is Nothing Then
            Sheets("有色金属").Cells(1, ENDCOL + 1) = Format(brr(i, 7), "yyyy-mm-dd")
            Sheets("有色金属").Cells(i + 1, ENDCOL + 1) = brr(i, 5)
         Else
            kk = Sheets("有色金属").Cells.Find(brr(i, 7)).Column
            Sheets("有色金属").Cells(i + 1, kk) = brr(i, 5)
         End If
      Next i
End With
Set Itm = Nothing
UserForm4.Show
End Sub