Очистка данных VBA в билетах

#html #excel #vba #web-scraping

#HTML #excel #vba #очистка веб-страниц

Вопрос:

Я новичок в vba и хочу очистить некоторые данные на веб-сайте продажи билетов. Поскольку я могу очистить данные о билетах в теге option и поместить их все в столбец B, у каждого <li class="mobile"> есть showname в теге <h3>

Вот html-код:

 <li class="mobile">
  <form>
   <h3>showname A</h3>
   <p class="tickeing">
     <select class="sec">
      <option value="19351">showtime 1</option>
      <option value="19381">showtime 2</option>
     </select>
   </p>
  </form>
</li>
<li class="mobile">
  <form>
   <h3>showname B</h3>
   <p class="tickeing">
     <select class="sec">
      <option value="19031">showtime 1</option>
      <option value="19231">showtime 2</option>
     </select>
   </p>
  </form>
</li>

и я могу поместить все время показа только в столбец B

 Dim Times As Object
Set Times = html.querySelectorAll("li.mobile option")
 For i = 0 To Times.Length - 1
 wsOne.Range("B" amp; i) = Times.Item(i).innerText
 Next i

Моя цель — поместить showname в столбец A и соответствующие showtime (ы) в столбец B, как я могу это решить?

 column A       column B
Show name A    Show time 1
Show name A    Show time 2
Show name B    Show time 1
Show name B    Show time 2

Я действительно признателен, если вы можете мне помочь, большое спасибо.

1. Возможно, вы захотите поделиться ссылкой на сайт, если это не проблема.

2. Уважаемый SIM, вот ссылка на сайт [ссылка] ( uacinemas.com.hk/eng/cinema/1101 ) , надеюсь, вы сможете мне помочь, спасибо

Ответ №1:

Хорошо, это должно сделать то, чего вы пытаетесь достичь.

 Sub fetchContent()
    Const Url$ = "https://www.uacinemas.com.hk/eng/cinema/1101"
    Dim Html As New HTMLDocument, Htmldoc As New HTMLDocument
    Dim Http As Object, sName$, Namp;, Ramp;, Iamp;
    Set Http = CreateObject("MSXML2.XMLHTTP")

    With Http
        .Open "GET", Url, False
        .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/84.0.4147.135 Safari/537.36"
        .send
        Html.body.innerHTML = .responseText
        With Html.querySelectorAll("li.mobile")
            For I = 0 To .Length - 1
                Htmldoc.body.innerHTML = .Item(I).outerHTML
                sName = Htmldoc.querySelector("h3 > a").innerText
                With Htmldoc.querySelectorAll("p.tickeing > select > option")
                    For N = 0 To .Length - 1
                        R = R   1: Cells(R, 1) = sName
                        Cells(R, 2) = .Item(N).innerText
                    Next N
                End With
            Next I
        End With
    End With
End Sub

Если вы хотите избавиться от этого ------ из столбца B, попробуйте это:

 With Htmldoc.querySelectorAll("p.tickeing > select > option")
    For N = 0 To .Length - 1
        If Not InStr(.Item(N).innerText, "----") > 0 Then
            R = R   1: Cells(R, 1) = sName
            Cells(R, 2) = .Item(N).innerText
        End If
    Next N
End With

Выходные данные, которые вы можете получить, похожи:

 Peninsula (Laser IMAX)  Tue, Sep 1, 08:30 PM IMAX HKD 120.00 (2D Laser IMAX)
Peninsula (Laser IMAX)  ---------------------------------------------------------
Peninsula (Laser IMAX)  Wed, Sep 2, 02:00 PM IMAX HKD 120.00 (2D Laser IMAX)
Peninsula (Laser IMAX)  Wed, Sep 2, 04:15 PM IMAX HKD 120.00 (2D Laser IMAX)
Peninsula (Laser IMAX)  Wed, Sep 2, 06:30 PM IMAX HKD 120.00 (2D Laser IMAX)
Peninsula (Laser IMAX)  Wed, Sep 2, 08:45 PM IMAX HKD 120.00 (2D Laser IMAX)
Peninsula (Laser IMAX)  ---------------------------------------------------------
Peninsula (Laser IMAX)  Thu, Sep 3, 02:00 PM IMAX HKD 120.00 (2D Laser IMAX)
Peninsula (Laser IMAX)  Thu, Sep 3, 04:15 PM IMAX HKD 120.00 (2D Laser IMAX)
Peninsula (Laser IMAX)  Thu, Sep 3, 06:30 PM IMAX HKD 120.00 (2D Laser IMAX)
Peninsula   Tue, Sep 1, 07:20 PM House 9 HKD 105.00 (2D ATMOS)
Peninsula   Tue, Sep 1, 07:40 PM House 7 HKD 95.00 (2D)
Peninsula   Tue, Sep 1, 08:05 PM Blackbox HKD 95.00 (2D)
Peninsula   Tue, Sep 1, 08:10 PM Whitebox HKD 95.00 (2D)
Peninsula   ---------------------------------------------------------
Peninsula   Wed, Sep 2, 02:00 PM House 10 HKD 115.00 (2D ATMOS)
Peninsula   Wed, Sep 2, 02:30 PM House 2 HKD 105.00 (2D)
Peninsula   Wed, Sep 2, 03:00 PM House 9 HKD 115.00 (2D ATMOS)
Peninsula   Wed, Sep 2, 03:45 PM Blackbox HKD 105.00 (2D)