VBA将输出刮到不同的行Excel

Question

我是使用 VBA 编写的新手。我一直在尝试抓取一个网站以获取有关船舶的数据。 所以我写了（大部分是复制的）一些脚本，我已经到了可以在立即窗口中打印正确结果的地步，但不能超越。我希望在 Excel 中打印相同的结果。我觉得答案就在附近，但我一直在苦苦挣扎，无法让它发挥作用。

脚本：

Sub Scrape()
'Get ship info

Dim ie As InternetExplorer

Dim html As MSHTML.HTMLDocument
Dim HTMLSCRAPE As MSHTML.IHTMLElementCollection
Dim HTMLSCR As MSHTML.IHTMLElement

Set ie = New InternetExplorer

ie.Visible = False

ie.navigate "https://www.marinetraffic.com/en/ais/details/ships/shipid:5081/mmsi:230352000/vessel:MARJATTA"

Do While ie.readyState <> READYSTATE_COMPLETE

Application.StatusBar = "Trying to go to StackOverflow ..."

DoEvents

Loop

Set html = ie.document

Set HTMLSCRAPE = html.getElementsByTagName("div")


i = 0
For Each HTMLSCR In HTMLSCRAPE
   Debug.Print HTMLSCR.className, HTMLSCR.tagName, HTMLSCR.ID, HTMLSCR.innerText
Next HTMLSCR




Set ie = Nothing

Application.StatusBar = ""

End Sub

即时窗口中的输出是：

ATD: 2020-01-22 09:34 LT (UTC +1)

ETA: 2020-01-24 01:30 LT (UTC +1)





PAST TRACK


ROUTE FORECAST

Reported ETA: 2020-01-24 01:30 LT (UTC +1)

Calculated ETA: ••••••••••


Calculated ETA at: ••••••••••


Predictive ETD: ••••••••••


Reported Destination: SEHEL


Distance Travelled: ••••••••••


Distance to Go: ••••••••••


Total Voyage Distance: ••••••••••


Time to Destination: ••••••••••



Draught (Reported/Max): 6.8 m / ••••••••••


Load Condition: ••••••••••


Speed recorded (Max / Average): 19 knots / 18.7 knots



VOYAGE TIMELINEPOSITION HISTORY

Reported Destination and ETA Received 2020-01-22 14:40 UTC

UNLOCK VOYAGE INFORMATION







Summary







Where is the ship?

General Cargo MARJATTA is currently located at UKC - North Sea at position 54° 46' 17.328" N, 5° 48' 27.821" E as reported by MarineTraffic Terrestrial Automatic Identification System on 2020-01-22 21:15 UTC (39 minutes ago)

The wind in this area at that time blows from West direction at force 2 Beaufort.

 

Where is this vessel going to?

The vessel departed from ROTTERDAM BOTLEK, NL on 2020-01-22 09:34 LT (UTC +1) and is currently sailing at 14.7 knots with Northeast direction heading to HELSINGBORG, SE with reported Estimated Time of Arrival at 2020-01-24 01:30 LT (UTC +1) local time (in 1 day, 2 hours )


 

What kind of ship is this?

MARJATTA (IMO: 9126247) is a General Cargo that was built in 1996 (24 years ago) and is sailing under the flag of Finland.

It’s carrying capacity is 6410 t DWT and her current draught is reported to be 6.8 meters. Her length overall (LOA) is 119.84 meters and her width is 17.9 meters.















Latest Position









Position Received: 2020-01-22 21:15 UTC
39 minutes ago

Vessel's Local Time: 
2020-01-22 21:15 LT UTC

Area: UKC - North Sea

Current Port: -

Latitude / Longitude: 54.77148° / 5.807728°

Status: Underway using Engine

Speed/Course: 14.7 kn / 33 °

AIS Source: 2701 Esvagt Alpha

NEARBY VESSELS


SHOW ON LIVE MAP



Weather





Wind: 4 knots

Wind direction: W (282°)

Air Temperature: 9°C
              DIV           wootric-area  
jss4          DIV                         









TermsPrivacyUser AgreementAbout
English (EN)MarineTraffic BlogHelp Centre
© Copyright 2007 - 2020 MarineTraffic.com
jss5          DIV                         








TermsPrivacyUser AgreementAbout
English (EN)MarineTraffic BlogHelp Centre
© Copyright 2007 - 2020 MarineTraffic.com
jss6          DIV                         







TermsPrivacyUser AgreementAbout
English (EN)MarineTraffic BlogHelp Centre
              DIV                         
jss8          DIV                         TermsPrivacyUser AgreementAbout
English (EN)MarineTraffic BlogHelp Centre
jss79         DIV                         TermsPrivacyUser AgreementAbout
jss13         DIV                         © Copyright 2007 - 2020 MarineTraffic.com
              DIV           MTLoader-1    
              DIV                         
              DIV                         
              DIV                         

如何让相同的输出在不同的行中表现出色？

编辑：每次我运行这个脚本，结果似乎都不同。

Answer 1

假设您要开始粘贴A1：

Dim i as Long
i = 1
For Each HTMLSCR In HTMLSCRAPE
   Worksheets("Sheet1").Cells(i,1).Value = _
      HTMLSCR.className & "," & HTMLSCR.tagName & "," & HTMLSCR.ID & "," & HTMLSCR.innerText
   i = i + 1
Next HTMLSCR

此外，这假设您可以直接打印 HTML 信息。

Answer 2

请阅读cmets：

Sub Scrape()
'Get ship info

Dim ie As InternetExplorer
'Dim html As MSHTML.HTMLDocument 'Not needed
Dim HTMLSCRAPE As MSHTML.IHTMLElementCollection
Dim HTMLSCR As MSHTML.IHTMLElement
Dim i As Long

  Set ie = New InternetExplorer
  ie.Visible = False
  ie.navigate "https://www.marinetraffic.com/en/ais/details/ships/shipid:5081/mmsi:230352000/vessel:MARJATTA"
  Do While ie.readyState <> READYSTATE_COMPLETE
    'Application.StatusBar = "Trying to go to StackOverflow ..." 'Not needed(?) Already not at all in the loop
    DoEvents
  Loop

  'Set html = ie.document 'Not needed

  Set HTMLSCRAPE = ie.document.getElementsByTagName("div")

  'Headline in the first row
  Cells(1, 1).Value = "Class Name"
  Cells(1, 2).Value = "Tag Name"
  Cells(1, 3).Value = "ID"
  Cells(1, 4).Value = "Inner Text"
  'Freeze first line
  ActiveWindow.SplitColumn = 0
  ActiveWindow.SplitRow = 1
  ActiveWindow.FreezePanes = True

  i = 2 'I use this variable for first row of dynamic data in the table
  For Each HTMLSCR In HTMLSCRAPE
    'Debug.Print HTMLSCR.className, HTMLSCR.tagName, HTMLSCR.ID, HTMLSCR.innerText
    '
    'Output the same values in the Excel spreadsheet from which you start the macro
    '(But I think, it's not realy what you want(?) Because it's EVERY div tag. Nobody needs every div tag in a document)
    'Please tell us ... Which values do you need?
    'Here come every div tags CSS class name if available [why?], tag name (div? ;-) [why?], id if available [why?] and innerText [which values you need?]
    Cells(i, 1).Value = HTMLSCR.className
    Cells(i, 2).Value = HTMLSCR.tagName
    Cells(i, 3).Value = HTMLSCR.ID
    Cells(i, 4).Value = HTMLSCR.innerText 'Makes the whole  table unreadable. I think you need one value of some lines
    i = i + 1
  Next HTMLSCR

  'Make the Table more readable by autofit rows and columns
  Columns("A:D").EntireColumn.AutoFit
  Cells.EntireRow.AutoFit

  ie.Quit 'Exit IE (realy needed)
  Set ie = Nothing          'If clean up objects than everyone (Not really necessary, but consistent)
  Set HTMLSCRAPE = Nothing  'If clean up objects than everyone (Not really necessary, but consistent)
  Set HTMLSCR = Nothing     'If clean up objects than everyone (Not really necessary, but consistent)
  'Application.StatusBar = "" 'Not needed (?)
End Sub