Сохраните все элементы из таблицы HTML в словаре сценариев, добавив также значения дубликатов

Question

Я хочу хранить в словаре все элементы, найденные в HTML-таблице.

У меня проблемы, когда у меня есть дубликаты, потому что мой приведенный ниже код больше не сохраняет элемент, и мне нужны все элементы из этой таблицы, даже если есть дубликаты.

Если у меня есть повторяющиеся значения, такие как Раунд 38, где другой Match3 имеет такое же число раундов, я хочу снова перечислить эти дублированные значения.

Результаты должны выглядеть так:

Раунд 38

Match1

Match2

Раунд 37

Match1

Match2

Раунд 38

Match3

Match4

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

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

Вот и все.