首页 > 解决方案 > 如何使用 VBA 从公共网站提取数据?

问题描述

我已经编写了代码,并试图从网站上提取几条单独的数据,但我的宏一遍又一遍地提取了几个副本。

Sub GetData()
Application.ScreenUpdating = False
Dim objIE As InternetExplorer
Dim itemEle As Object
Dim desc As String, pt1 As String, pt2 As String, price As String
Dim y As Integer
Dim Number As String
Dim data1 As Variant, data2 As Variant, data3 As String
Dim WebsiteLink As String
Dim o.TEMP, p.TEMP, t.TEMP
Dim StatusBarCount As Integer
Dim M.Value2019 As String, B.Use As String, Fram As String
Dim x As Integer
Dim counter As Integer
Dim Year As String
StatusBarCount = 0
o.TEMP = ""
p.TEMP = ""
t.TEMP = ""
Worksheets("Results").Activate
Range("A3").Select
Selection.End(xlDown).Select
LastRow = ActiveCell.Row

On Error Resume Next

Set objIE = New InternetExplorer
objIE.Visible = False
Do While objIE.readyState = READYSTATE_COMPLETE: DoEvents: Loop

Worksheets("Results").Activate
x = 3
counter = 2
For x = 3 To LastRow Step 1 'LastRow

Number = Range("B" & x).Value
    objIE.navigate "website/" & Number 'M.data
Do While objIE.readyState = READYSTATE_COMPLETE: Loop
'Do While objIE.readyState = 4: DoEvents: Loop
'Do Until objIE.readyState = 4: DoEvents: Loop
While objIE.Busy
DoEvents
Wend


For Each itemEle In objIE.document.getElementsByClassName("data-table cssWidth100")
    M.Value2019 = itemEle.getElementsByTagName("td")(1).innerText

'            B.Use = objIE.document.getElementsByTagName("td") 
(99).innerText
'            Year = objIE.document.getElementsByTagName("td")(101).innerText
'            Fram = objIE.document.getElementsByTagName("td")(92).innerText
        x = counter
        Range("T" & x).Value = M.Value2019
'            Range("U" & x).Value = Year
'            Range("V" & x).Value = B.Use
'            Range("W" & x).Value = Fram
       Exit For
Next
For Each itemEle In 
objIE.document.getElementsByClassName("cssDetails_TopContainer 
cssTableContainer cssOverFlow_x")
    B.Use = itemEle.getElementsByClassName("cssDetails_Top_Cell_Data")(6).innerText
'        Year = itemEle.getElementsByClassName("cssRight")(7).innerText
'        Fram = itemEle.getElementsByClassName("cssRight")(2).innerText
'            Range("U" & x).Value = Year
        x = counter
        Range("V" & x).Value = B.Use
'            Range("W" & x).Value = Fram
Exit For
Next


'Update the status bar at the bottom of the excel sheet
    M.Value2019 = ""
    B.Use = ""
    StatusBarCount = StatusBarCount + 1
    Application.StatusBar = "Pulling data - Please wait... " & 
StatusBarCount
    Range("X" & x).Value = Number
counter = counter + 1
Next x


objIE.Quit
Application.StatusBar = "Finished!"
MsgBox "Finished!"

End Sub

我希望收到与输入网站的特定数字有关的信息,但是当它返回到 Excel 时,这些信息通常是重复的。它会有一些个体,但通常我们会看到类似的东西。

'54,678
'54,678
'48,900
'102,905
'102,905
'102,905

下一次类似但不同的数字。

先感谢您。

标签: excelvbaweb-scraping

解决方案


推荐阅读