Проверить, существует ли значение, если не добавить в список - PullRequest
1 голос
/ 08 мая 2020

Моя цель: Проверить, существует ли значение, если значение не существует, добавить в конец столбца A. Если значение существует, пропустите идентификатор и проверьте следующее значение.

Фактический результат: Идентификаторы будут добавлены в конец строки A, независимо от того, существует это значение или нет. Поэтому получаю дубликаты.

Я пробовал с «если», но получаю ошибку.

Моя кодировка:

Option Explicit


Sub ExposeID()

Dim browser As Object   'Aufnehmen der verwendeten Instanz des Browsers (Internet Explorer)
Dim knotenAst As Object 'Aufnehmen einer HTML Struktur aus dem Browser Dokument
Dim n As Integer
Dim url As String       'Aufnehmen der auszulesenden Adresse

Dim ExposeID As String
Dim letztezeile As Integer
Dim nodeList As Object, i As Long

Set browser = CreateObject("internetexplorer.application")
    browser.Visible = False

For n = 0 To 1

    url = "https://www.immobilienscout24.de/Suche/de/niedersachsen/oldenburg-oldenburg/haus-kaufen?pagenumber=" & n + 1
    browser.navigate url
    Do Until browser.readyState = 4: DoEvents: Loop

    letztezeile = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

Set nodeList = browser.document.querySelectorAll(".result-list__listing[data-id]")

For i = 0 To nodeList.Length - 1

    ''' HERE IS THE PROBLEM '''
    If nodeList.Item(i).getAttribute("data-id") <> Cells.Range("A:A") Then
       Cells(letztezeile + i + 1, 1) = nodeList.Item(i).getAttribute("data-id")

    Else

    End If

Next i

Next n

Set nodeList = Nothing
browser.Quit

End Sub

Ответы [ 2 ]

1 голос
/ 08 мая 2020

Значения, распознанные как текст

Вы можете использовать функцию Match для сравнения значений, как написано в комментариях:

If IsError(Application.Match(nodeList.Item(i).getAttribute("data-id"), Cells.Range("A:A"), 0)) Then

Проблема в том, что данные распознаются как текст , а при записи на лист преобразуется в целое число. Вы можете преобразовать текст в число с помощью функции Val. Посмотрите на критическую строку в коде:

Option Explicit

Sub ExposeID()

    Dim browser As Object   'Aufnehmen der verwendeten Instanz des Browsers (Internet Explorer)
    Dim knotenAst As Object 'Aufnehmen einer HTML Struktur aus dem Browser Dokument
    Dim n As Integer
    Dim url As String       'Aufnehmen der auszulesenden Adresse

    Dim ExposeID As String
    Dim letztezeile As Integer
    Dim nodeList As Object, i As Long

    Set browser = CreateObject("internetexplorer.application")
        browser.Visible = False

    For n = 0 To 1

        url = "https://www.immobilienscout24.de/Suche/de/niedersachsen/" _
          & "oldenburg-oldenburg/haus-kaufen?pagenumber=" & n + 1
        browser.navigate url
        Do Until browser.readyState = 4: DoEvents: Loop

        letztezeile = Cells(Rows.Count, 1).End(xlUp).Row

        Set nodeList = browser.document.querySelectorAll( _
          ".result-list__listing[data-id]")

        For i = 0 To nodeList.Length - 1

            If IsError(Application.Match(Val(nodeList.Item(i) _
              .getAttribute("data-id")), Cells.Range("A:A"), 0)).Value Then
                Cells(letztezeile + i + 1, 1).Value = nodeList.Item(i) _
                  .getAttribute("data-id")
            Else

            End If

        Next i

    Next n

    Set nodeList = Nothing
    browser.Quit

End Sub

Я думаю, что эта версия Inte rnet Explorer слишком медленная, поэтому вы можете задать другой вопрос, как решить эту проблему с помощью xhr (XML HTTP запрос).

0 голосов
/ 08 мая 2020

Я нашел способ, как это могло работать. Но есть одна проблема. Он пропускает для каждой записи, которая уже существует, одну строку.

Option Explicit

'Version vom 08.05.2020
' Coding funktioniert, aber Leerzeichen


Sub ExposeID()

Dim browser As Object   'Aufnehmen der verwendeten Instanz des Browsers (Internet Explorer)
Dim knotenAst As Object 'Aufnehmen einer HTML Struktur aus dem Browser Dokument
Dim n As Integer
Dim url As String       'Aufnehmen der auszulesenden Adresse

Dim ExposeID As String
Dim letztezeile As Integer
Dim nodeList As Object, i As Long

Set browser = CreateObject("internetexplorer.application")
    browser.Visible = False

For n = 0 To 1

    url = "https://www.immobilienscout24.de/Suche/de/niedersachsen/oldenburg-oldenburg/haus-kaufen?pagenumber=" & n + 1
    browser.navigate url
    Do Until browser.readyState = 4: DoEvents: Loop

    letztezeile = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

Set nodeList = browser.document.querySelectorAll(".result-list__listing[data-id]")

For i = 0 To nodeList.Length - 1
Dim x As Integer

Dim FindString As String
Dim Rng As Range
FindString = nodeList.Item(i).getAttribute("data-id")
If Trim(FindString) <> "" Then
    With Sheets("IDs").Range("A:A") 'searches all of column A
        Set Rng = .Find(What:=FindString, _
                        After:=.Cells(.Cells.Count), _
                        LookIn:=xlValues, _
                        LookAt:=xlWhole, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False)
        If Not Rng Is Nothing Then

        Else
          Cells(letztezeile + i + 1, 1) = nodeList.Item(i).getAttribute("data-id")
        End If
    End With
End If

Next i

Next n

Set nodeList = Nothing
browser.Quit

End Sub

enter image description here

...