html - VBA 在票务中抓取数据

Question

我是 vba 的新手，想在票务网站上抓取一些数据。
因为我可以在 option 的标签中刮取票务数据并将它们全部放在 B 列中，每个 <li class="mobile">在 <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" & i) = Times.Item(i).innerText
 Next i

我的目标是将演出名称放在 A 列中，将相关的放映时间放在 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

如果你能帮助我，我真的很感激，非常感谢。

Answer 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$, N&, R&, I&
    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)