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

Question

我想将在 html table.

中找到的所有项目存储在字典中

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

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

结果应如下所示：

第38轮

匹配 1

匹配 2

第37轮

匹配 1

匹配 2

第38轮

匹配 3

匹配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，这可能意味着您希望稍后快速搜索某些项目的存在。一个可能的解决方案是 "count" 每个项目（键）的出现次数并将此数字存储在相应的值字段中。

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

就是这样。

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

Store all the items from a HTML table in to a Scripting Dictionary, adding also the duplicates values

html

excel

vba

scripting.dictionary