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

Liên hệ QC
randaubienghoc

randaubienghoc

Thành viên mới
Tham gia
28/1/13
Bài viết
25
Được thích
1
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.

1587534302497.png

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
 

File đính kèm

  • PULL DATA FROM WEB.xlsm
    20.7 KB · Đọc: 37
Sắp xếp theo thời gian sắp xếp theo bầu chọn
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
 
Upvote 0
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.
 
Upvote 0
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
Nhấp chuột vào đây để mở rộng...
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 ạ :((
 
Upvote 0
Bị lỗi chỗ này ạ
Mã: 
Set IE = VBA.CreateObject("InternetExplorer.Application")
 
Upvote 0
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
 
Upvote 0
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 ạ :((
Nhấp chuột vào đây để mở rộng...
------------------------------------

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
 
Lần chỉnh sửa cuối:
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

D
Định dạng trong excel làm nghiệm thu đường
2
Trả lời
27
Đọc
13K
HieuCD
H
V
  • Question
GIúp code xóa các tên mặt hàng trùng nhau, chỉ chừa lại tên cho dòng trên cùng
Trả lời
4
Đọc
86
cantl
C
L
Tạo hàm Round cho nhiều dòng
Trả lời
10
Đọc
6K
cantl
C
dunghtgiga
Không cho người khác chỉnh sửa nội dung bảng tính
Trả lời
5
Đọc
171
cantl
C
phunguyenkt
  • Question
MN cho em xin phần mềm chuyển đổi số sang chữ với ạ, và ko có chữ chẵn, em cảm ơn
Trả lời
3
Đọc
192
le_vis
L
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

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

Back
Top Bottom