Ошибка дублирования данных при копировании из Интернета в Excel

Question

Мне нужна ваша помощь в кодировании для передачи данных из Интернета в Excel.

Интернет для получения данных:

https://eport.saigonnewport.com.vn/Pages/Common/Containers_new

• Шаги для получения данных:

Поместите «Cát Lái» в поле «Khu vự c giao nhận container» (выберите морской порт)

Укажите номер контейнера в поле «Контейнер»

Снимите флажок «Chỉ vòng luân chuyển cuối», чтобы отобразить все строки в таблице данных

Нажмите «Поиск», чтобы отобразить таблицу данных - результат поиска информации о контейнере

ВЫПУСК: Данные, извлеченные из Интернета в Excel для каждой строки в Excel (в соответствии с каждым найденным номером контейнера), похоже, совпадают с предыдущим результатом, В то время как информация для этого номера контейнера может быть пустой. Например: Время события 2 «04.10.2020 15:07:00 PM» повторяется для контейнера «TEMU3311320», в то время как у этого контейнера нет времени события 2.

Надеюсь, вы могли бы дать мне любые советы, чтобы решить эту проблему дублирования. Прикрепленный файл Excel для ваших ссылок. Спасибо.

Sub PullDataFromWeb()
  Dim IE As Object, W As Excel.Worksheet
  Dim doc As HTMLDocument
  Dim lastRow As Integer, b As Boolean, tmp As String
  Dim lis, li
  Set W = ThisWorkbook.Sheets("Sheet1")
  Set IE = VBA.CreateObject("InternetExplorer.Application")
  IE.Visible = True   'hien cua so IE
  IE.navigate "https://eport.saigonnewport.com.vn/Pages/Common/Containers_new"
  Do While IE.Busy Or IE.readyState <> 4      'doi IE chay xong
    Application.Wait DateAdd("s", 1, Now)
  Loop
  Set doc = IE.document

  lastRow = W.Range("B" & W.UsedRange.Rows.Count + 2).End(xlUp).Row        'dong cuoi cung trong cot B container
  If lastRow < 2 Then GoTo Ends
  On Error Resume Next
  For intRow = 2 To lastRow     'tu dong toi dong
    b = False
    b = W.Range("I" & intRow).Value Like "[Yy]"
    If W.Range("B" & intRow).Value <> "" And Not b Then
      doc.getElementById("txtItemNo_I").Value = W.Range("B" & intRow).Value 'so cont
      doc.getElementById("cbSite_VI").Value = W.Range("A" & intRow).Value
      doc.getElementById("chkInYard_I").Checked = False
      doc.getElementById("ContentPlaceHolder2_btnSearch").Click 'click Search
      '----------------------------------------------
      Do While IE.Busy Or IE.readyState <> 4
        Application.Wait DateAdd("s", 1, Now)
      Loop
      '----------------------------------------------
      strFindContainer = doc.getElementById("ContentPlaceHolder2_lblNotice").innerText
      W.Range("H" & intRow) = strFindContainer
      If strFindContainer Like "T*m th*y * container*" Then
        strEventtime1 = doc.getElementById("grdContainer_DXDataRow0").Cells(0).innerText
        strEventtype1 = doc.getElementById("grdContainer_DXDataRow0").Cells(1).innerText
        strLocation1 = doc.getElementById("grdContainer_DXDataRow0").Cells(2).innerText
        strEventtime2 = doc.getElementById("grdContainer_DXDataRow1").Cells(0).innerText
        strEventtype2 = doc.getElementById("grdContainer_DXDataRow1").Cells(1).innerText
        W.Range("C" & intRow) _
          .Resize(, 5).Value = Array(strEventtime1, strEventtype1, strLocation1, _
                         strEventtime2, strEventtype2)
      End If
    End If
  Next
Ends:
  IE.Quit
  Set IE = Nothing    'Cleaning up
  Set objElement = Nothing
  Set objCollection = Nothing
  Application.StatusBar = ""
  Application.DisplayAlerts = True
End Sub

Answer 1

Перед этим последним Next убедитесь, что вы присваиваете все соответствующие строковые переменные для vbNullstring, т. Е. Те, которые в Array(strEventtime1, strEventtype1, strLocation1, strEventtime2, strEventtype2), как и внутри If, тогда, когда If не выполнено, предыдущие значения будут сохранены в последующих l oop итераций.