Lấy dữ liệu từ Web vào Excel (chỉ chạy cho một số dòng theo tiêu chí & lỗi lặp dữ liệu) / Scraping data from Web to Excel

randaubienghoc · 22/4/20

Anh/ chị trên diễn đàn GPE thân mến,

Em rất mong được anh/ chị gỡ rối giúp em về 2 vấn đề trong lập trình VBA khi chạy lấy dữ liệu từ web: https://eport.saigonnewport.com.vn/Pages/Common/Containers_new
vào Excel, với mục đích tự động lấy thông tin theo dõi container về cảng Cát Lái, hỗ trợ việc theo dõi thông tin hàng hóa về cảng, lĩnh vực xuất nhập khẩu.

* Bảng dưới đây từ file Excel là kết quả chạy macro để lấy dữ liệu về thời gian, vị trí, sự kiện của mỗi container trong cột Container. Chi tiết như file đính kèm.

Port	Container	Event time1	Event type1	Location1	Event time2	Event type2	Tim thay cont?	Status
CTL	CMAU0117028	5/4/2020 7:46	UNLOAD	000.00.00	10/4/2020 15:07	OUTGATE	Tìm thấy 1 container.	N
CTL	TEMU3311320	4/4/2020 15:09	OUTGATE		10/4/2020 15:07	OUTGATE	Tìm thấy 1 container.	Y
CTL		4/4/2020 15:09	OUTGATE		10/4/2020 15:07	OUTGATE	Không tìm thấy container.	Y
CTL	CGMU9346492	4/4/2020 15:09	OUTGATE		10/4/2020 15:07	OUTGATE	Không tìm thấy container.	N

* Hình dưới đây mô phỏng dữ liệu từ web, nếu nhập thủ công theo các bước tra cứu thông tin container: 1- chọn khu vực cảng Cát Lái, 2- nhập thông tin số container, 3- bỏ chọn mục "chỉ vòng luân chuyển cuối", 4- click chọn "Tìm kiếm", 5- lấy dữ liệu liên quan (thời gian, vị trí, sự kiện) từ bảng dữ liệu.

Hiện tại code đã chạy lấy dữ liệu được, tuy nhiên còn gặp phải 2 vấn đề:

1/ Để giảm tải thời gian chạy macro cho những container đã kết thúc theo dõi tương ứng dữ liệu "Status: Y", chỉ chạy macro tìm kiếm container và lấy dữ liệu từ web với "Status: N" trong Excel. Em đã viết code điều kiện "if... then..." mà macro vẫn chạy hết cho tất cả các dòng. Như vậy nếu nhiều dòng mà chạy từ đầu sẽ rất mất thời gian.
2/ Hiện tại em gặp trường hợp nếu bị dữ liệu từ web trống nhưng khi chạy macro về, dữ liệu bị lặp từ thông tin dòng trước đó. Ví dụ sự kiện "4/4/2020 15:09" bị lặp từ dòng 2.

Rất mong anh/ chị có thể hướng dẫn giúp em, vì tự tìm tòi học hỏi trên mạng nên có nhiều vấn đề chưa được hiểu sâu.

Em xin cảm ơn.

Dương
Mobile/ Zalo: +84-35 273 6558
Skype: ran_dau_bieng_hoc
Mail: nguyenminhduong49@gmail.com

P/S: code được viết như trong file Excel đính kèm hoặc như dưới đây:

Sub PullDataFromWeb()

Dim IE As Object
Dim doc As HTMLDocument
Dim lastRow As Integer

Set IE = 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

With ActiveSheet
lastRow = .Range("B" & .Rows.Count).End(xlUp).Row 'dong cuoi cung trong cot B container
End With

On Error Resume Next

For intRow = 2 To lastRow 'tu dong toi dong

Dim rng As Range
Set rng = Range("I2:I" & lastRow)
For Each cell In rng
If cell.Value = "Y" Then

End If
Next cell

IE.document.getElementById("txtItemNo_I").Value = ThisWorkbook.Sheets("Sheet1").Range("B" & intRow).Value 'so cont
doc.getElementById("cbSite_VI").Value = "CTL" 'cang Cat Lai CTL
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
ThisWorkbook.Sheets("Sheet1").Range("H" & intRow).Value = strFindContainer

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

ThisWorkbook.Sheets("Sheet1").Range("C" & intRow).Value = strEventtime1
ThisWorkbook.Sheets("Sheet1").Range("D" & intRow).Value = strEventtype1
ThisWorkbook.Sheets("Sheet1").Range("E" & intRow).Value = strLocation1

ThisWorkbook.Sheets("Sheet1").Range("F" & intRow).Value = strEventtime2
ThisWorkbook.Sheets("Sheet1").Range("G" & intRow).Value = strEventtype2

Do While IE.Busy Or IE.readyState <> 4
Application.Wait DateAdd("s", 1, Now)
Loop

Next

IE.Quit
Set IE = Nothing 'Cleaning up
Set objElement = Nothing
Set objCollection = Nothing
Application.StatusBar = ""
Application.DisplayAlerts = True

End Sub

HeSanbi · 22/4/20

Bạn có thể sử dụng đoạn code dưới đây:

--------------

JavaScript:

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

randaubienghoc · 22/4/20

Tuyệt quá. Em cảm ơn anh rất rất nhiều ^^
Em đã đi tìm lời giải bấy lâu nay mà tới giờ mới có đáp án.

randaubienghoc · 25/4/20

HeSanbi đã viết:

Bạn có thể sử dụng đoạn code dưới đây:

--------------

JavaScript:

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

Hi anh. Em có kiểm tra lại thì thấy: Hiện tại đã khắc phục được vấn đề 1, nhưng còn vấn đề 2 về việc dữ liệu bị lặp thì chưa khắc phục được ạ, ví dụ dữ liệu Eventime 2 "10/4/2020 15:07" bị lặp cho thông tin container 2 "TEMU3311320" (lặp từ container 1 "CMAU0117028") trong khi thực chất container 2 không có dữ liệu Eventime 2.
Anh xe giúp em với ạ

(

quyenpv · 25/4/20

Bị lỗi chỗ này ạ

Mã:

Set IE = VBA.CreateObject("InternetExplorer.Application")

randaubienghoc · 25/4/20

Em cam on moi nguoi. Em tim ra cach roi a. Chi can dat lai gia tri ve "" truoc khi Next la giai quyet duoc van de ^_^
sua code:

strEventtime2 = ""
strEventtype2 = ""

Next

HeSanbi · 25/4/20

randaubienghoc đã viết:
Hi anh. Em có kiểm tra lại thì thấy: Hiện tại đã khắc phục được vấn đề 1, nhưng còn vấn đề 2 về việc dữ liệu bị lặp thì chưa khắc phục được ạ, ví dụ dữ liệu Eventime 2 "10/4/2020 15:07" bị lặp cho thông tin container 2 "TEMU3311320" (lặp từ container 1 "CMAU0117028") trong khi thực chất container 2 không có dữ liệu Eventime 2.
Anh xe giúp em với ạ (

------------------------------------

Code có thể sửa lại như bên dưới.

Web tìm kiếm có thể tìm kiếm cùng lúc nhiều mã, điền mã cách nhau dấu phẩy:
CMAU0117028,CGMU9346492,TEMU3311320
Thì không cần đến vòng lặp từ 2 đến cuối.

Nhưng Code của bạn rất phiền phức khi tắt mở IE. Tôi không bao giờ viết code như vậy.
Khi ứng dụng đóng thì IE mới đóng, chứ không phải vừa chạy xong là đóng IE.

------------------------------------

JavaScript:

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 = ""
      strFindContainer = doc.getElementById("ContentPlaceHolder2_lblNotice").innerText
      W.Range("H" & intRow) = strFindContainer
      If strFindContainer Like "T*m th*y * container*" Then
        With W.Range("C" & intRow)
          .Value = doc.getElementById("grdContainer_DXDataRow0").Cells(0).innerText
          .Offset(, 1).Value = doc.getElementById("grdContainer_DXDataRow0").Cells(1).innerText
          .Offset(, 2).Value = doc.getElementById("grdContainer_DXDataRow0").Cells(2).innerText
          .Offset(, 3).Value = doc.getElementById("grdContainer_DXDataRow1").Cells(0).innerText
          .Offset(, 4).Value = doc.getElementById("grdContainer_DXDataRow1").Cells(1).innerText
        End With
      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

quick87 · 27/4/20

quyenpv đã viết:
Bị lỗi chỗ này ạ

Mã:

Set IE = VBA.CreateObject("InternetExplorer.Application")

Trong cửa sổ VBE, bạn click chọn tab Tool > Reference

Và tick chọn cái phía dưới:

Rồi chạy lại thử nhé.

Lấy dữ liệu từ Web vào Excel (chỉ chạy cho một số dòng theo tiêu chí & lỗi lặp dữ liệu) / Scraping data from Web to Excel

randaubienghoc

Thành viên mới

File đính kèm

HeSanbi

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

randaubienghoc

Thành viên mới

randaubienghoc

Thành viên mới

quyenpv

Thu nhặt kiến thức

randaubienghoc

Thành viên mới

HeSanbi

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

quick87

(/ội...

Bài viết mới nhất

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng