html - 将 HTML 表中的所有项目存储到脚本字典中，同时添加重复值

Question

我想将在 html 表中找到的所有项目存储在字典中。

当我有重复时我会遇到问题，因为我的下面的代码不会再次存储该项目，而且我需要这个表中的所有项目，即使有任何重复项也是如此。

如果我有像 Round 38 这样的重复值，其中另一个 Match3 具有相同的轮数，我想再次列出这些重复值。

结果应该是这样的:

第38轮

匹配1

匹配2

第37轮

匹配1

匹配2

第38轮

三消

匹配4

................................

Sub Get_URL_Addresses_test()

Dim URL As String
Dim ie As New InternetExplorer
Dim HTMLdoc As HTMLDocument
Dim dictObj As Object: Set dictObj = CreateObject("Scripting.Dictionary")
Dim tRowID As String

URL = "http://www.flashscore.ro/fotbal/anglia/premier-league-2015-2016/rezultate/"

With ie
    .navigate URL
    .Visible = True
    Do Until .readyState = READYSTATE_COMPLETE: DoEvents: Loop
    Set HTMLdoc = .document
End With


For Each objLink In ie.document.getElementsByTagName("a")

   If Left(objLink.innerText, 4) = "Show" Or Left(objLink.innerText, 4) = "Arat" Then

        objLink.Click
        Application.Wait (Now + TimeValue("0:00:01"))
        objLink.Click
        Application.Wait (Now + TimeValue("0:00:01"))
        objLink.Click
        Application.Wait (Now + TimeValue("0:00:01"))
        'Exit For

   End If

Next objLink


With HTMLdoc

    Set tblSet = .getElementById("fs-results")
    Set mTbl = tblSet.getElementsByTagName("tbody")(0)
    Set tRows = mTbl.getElementsByTagName("tr")
    With dictObj

        For Each tRow In tRows

            If tRow.getAttribute("Class") = "event_round" Then
                tRowClass = tRow.innerText
                'MsgBox tRowClass
                If Not .Exists(tRowClass) Then
                    .add tRowClass, Empty
                End If
            End If

            tRowID = Mid(tRow.ID, 5)
            If Not .Exists(tRowID) Then
                .add tRowID, Empty
            End If


        Next tRow
    End With
End With

i = 14
For Each Key In dictObj

    If Left(Key, 5) = "Runda" Or Left(Key, 5) = "Round" Then
        ActiveSheet.Cells(i, 2) = Key
    Else
        ActiveSheet.Cells(i, 2) = "http://www.flashscore.ro/meci/" & Key & "/#sumar-meci"
    End If

    i = i + 1

    'MsgBox Key
    'Debug.Print Key
Next Key

Set ie = Nothing
MsgBox "Process Completed"

End Sub

Answer 1

您可以将项目存储在允许重复的通用容器中，例如集合或数组。但是由于您将它们作为 keys 存储在字典中，这可能意味着您希望稍后快速搜索某些项目是否存在。一种可能的解决方案是“计算”每个项目(键)出现的次数，并将此数字存储在相应的值字段中。

If tRow.getAttribute("Class") = "event_round" Then
    tRowClass = tRow.innerText
    dim n as Integer: n = dictObj.Item(tRowClass) ' creates and returns 0 if no exist yet
    dictObj.Item(tRowClass) = n + 1
End If

稍后您将能够检查字典中是否存在任何键，以及该键出现的次数。

编辑

正如我所怀疑的那样，您只是将字典用作普通容器，但由于您希望允许重复项，因此 Dictiobary 不是您要采用的方式。只需使用一个 Collection。这是对代码的最小更改:

Set dictObj = CreateObject("Scripting.Dictionary") --> Set dictObj = new Collection

If Not .Exists(tRowClass) Then .add tRowClass, Empty End If

将上面的内容(3 行)替换为:

.add tRowClass

就是这样。