VBA выскабливал вывод в разные строки Excel - PullRequest
0 голосов
/ 23 января 2020

Я новичок в VBA. Я пытался очистить сайт для данных о кораблях. Итак, я написал (ну, в основном, скопировал) некоторый скрипт, я дошел до того, что могу печатать правильные результаты в окне «Немедленно», но не для того, чтобы преуспеть. Я sh, чтобы напечатать те же результаты в 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                         

Как мне получить этот же вывод, чтобы превзойти в разных строках?

РЕДАКТИРОВАТЬ: каждый раз, когда я запускаю этот скрипт, результаты, кажется, отличаются.

Ответы [ 2 ]

0 голосов
/ 23 января 2020

Пожалуйста, прочитайте комментарии:

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
0 голосов
/ 23 января 2020

Допустим, вы хотите начать вставку в 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 напрямую.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...