如何使用VBA在网站表中查找特定值(找到解决方案)

时间:2017-09-19 17:27:30

标签: excel-vba vba excel

已找到解决方案。我已经用我所拥有的代码替换了代码,以防任何人都需要做任何类似的事情。我很感谢那些回复者的帮助。

昨天我问了一个问题,试图获取一个excel宏来获取一些网站数据并从网站上扔掉一个特定的值。我相信我将不得不抓取网站并将信息转储到新的工作表中,然后努力阻止我需要的数据。以下代码不会丢弃任何错误,但不会将任何数据粘贴到新工作表中。站点加载和添加了名为GCMP的新工作表。我从http://www.vbaexpress.com/forum/showthread.php?47374-VBA-getElementsByTagName-Issues找到了这个样本。问题可能是Delement.className = "dist_body"不知道要提取哪些数据。该网站使用了dist_body,mdist,tbody(table)。

Sub gcmData()

Dim htm As Object
Dim Tr As Object
Dim Td As Object
Dim Tab1 As Object
Dim rSearch As Object

'Grabs URL Tool Data Sheet
Web_URL = ['Tool Data'!B2]

'Create HTMLFile Object
Set HTML_Content = CreateObject("htmlfile")

'Get the WebPage Content to HTMLFile Object
With CreateObject("msxml2.xmlhttp")
.Open "GET", Web_URL, False
.send
HTML_Content.body.innerHTML = .responseText 'this is the highlighted part for the error
End With

Sheets.Add.Name = "GCMP"
Sheets("GCMP").Range("A1").Select

Column_Num_To_Start = 1
iRow = 2
iCol = Column_Num_To_Start
iTable = 0

'Loop Through Each Table and Download it to Excel in Proper Format
For Each Tab1 In HTML_Content.getElementsByTagName("table")
With HTML_Content.getElementsByTagName("table")(iTable)
For Each Tr In .Rows
For Each Td In Tr.Cells
Sheets("GCMP").Cells(iRow, iCol).Select
Sheets("GCMP").Cells(iRow, iCol) = Td.innerText
iCol = iCol + 1
Next Td
iCol = Column_Num_To_Start
iRow = iRow + 1
Next Tr
End With

iTable = iTable + 1
iCol = Column_Num_To_Start
iRow = iRow + 1
Next Tab1
'Takes the data pulled from the website and searchs for the cell with Total. It pulls the cell value next to it removes
'the comma and mi. Then pops a test msg box with the value, then it divides the number by two and pops another msgbox to
' make sure it can be manipulated as a number for further use.

On Error Resume Next
 With Sheets("GCMP").Range("A1").Select
  Dim s As String
  Dim n As String
  Cells.Select
    Set rSearch = Selection.Find(what:="Total", After:=ActiveCell, LookIn:=xlFormulas, _
        Lookat:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
        ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
        s = ActiveCell.Value
        s = Replace(s, ",", "")
        s = Replace(s, " mi", "")
        MsgBox s
        n = s / 2
        MsgBox n

End With
 Application.DisplayAlerts = False
 Sheets("GCMP").Delete
 Application.DisplayAlerts = True
End Sub

0 个答案:

没有答案