nhờ viết dùm code vòng lập lấy data từ ngày đến ngày

Liên hệ QC
K

ketoan113

Thành viên hoạt động
Tham gia
10/3/07
Bài viết
199
Được thích
30
kính gửi các anh chị
em có mày mò viết vba lấy data từ web cafef.vn về, file em nó như sau:

ô B3 = mã cp
ô F3 = ngày bắt đầu (trong code em ghi là ngaybd)
ô I3 = ngày kết thúc (trong code em nghi là ngaykt)

vd ngày hiện tại em gõ = 10/11/2022, code hiện tại của em sẽ lấy data là ngày bắt đầu (10/11/2022), sau đó copy data em cần sang paste vào sheet1

nhưng em cần lấy data từ ngày đến ngày ( từ ngày bắt đầu đến ngày kết thúc) em không viết viết code sao,

em nhờ anh chị giúp em xíu, viết dùm em code vòng lập với ạ

em cảm ơn các anh chị

p/s: anh anhtuan2939 có đọc được topic của em thì giúp em với nhé, tks a ạ
 

File đính kèm

  • Chi tiet giao dich CK - Copy.xlsm
    135.3 KB · Đọc: 37
Sắp xếp theo thời gian sắp xếp theo bầu chọn
Nếu dùng Query thì phải dùng cái này này. Có sẵn ví dụ ngon lành luôn.

www.giaiphapexcel.com

Lập trình trong Power Query và các ví dụ

Lời tựa: Mấy năm gần đây, Power Query đã dần được sử dụng nhiều hơn mặc dù Microsoft (MS) đã hỗ trợ từ Excel 2010. Ở phạm vi diễn đàn, trên các kênh/ trang mạng hướng dẫn khác cũng có khá nhiều tài liệu, các ví dụ về lập trình trình trong Power Query. Power Query có hỗ trợ môi trường lập...
www.giaiphapexcel.com www.giaiphapexcel.com

Mấy cái lấy dữ liệu web thì cứ Python là tiện nhất.
 
Upvote 0
befaint đã viết:
Nếu dùng Query thì phải dùng cái này này. Có sẵn ví dụ ngon lành luôn.

www.giaiphapexcel.com

Lập trình trong Power Query và các ví dụ

Lời tựa: Mấy năm gần đây, Power Query đã dần được sử dụng nhiều hơn mặc dù Microsoft (MS) đã hỗ trợ từ Excel 2010. Ở phạm vi diễn đàn, trên các kênh/ trang mạng hướng dẫn khác cũng có khá nhiều tài liệu, các ví dụ về lập trình trình trong Power Query. Power Query có hỗ trợ môi trường lập...
www.giaiphapexcel.com www.giaiphapexcel.com

Mấy cái lấy dữ liệu web thì cứ Python là tiện nhất.
Nhấp chuột vào đây để mở rộng...
python em ko rành ạ , e bit xíu vba thôi
 
Upvote 0
ketoan113 đã viết:
kính gửi các anh chị
em có mày mò viết vba lấy data từ web cafef.vn về, file em nó như sau:

ô B3 = mã cp
ô F3 = ngày bắt đầu (trong code em ghi là ngaybd)
ô I3 = ngày kết thúc (trong code em nghi là ngaykt)

vd ngày hiện tại em gõ = 10/11/2022, code hiện tại của em sẽ lấy data là ngày bắt đầu (10/11/2022), sau đó copy data em cần sang paste vào sheet1

nhưng em cần lấy data từ ngày đến ngày ( từ ngày bắt đầu đến ngày kết thúc) em không viết viết code sao,

em nhờ anh chị giúp em xíu, viết dùm em code vòng lập với ạ

em cảm ơn các anh chị

p/s: anh anhtuan2939 có đọc được topic của em thì giúp em với nhé, tks a ạ
Nhấp chuột vào đây để mở rộng...
bác anhtuan2939 ơi giúp em với, tks ạ
 
Upvote 0
befaint đã viết:
Nếu dùng Query thì phải dùng cái này này. Có sẵn ví dụ ngon lành luôn.

www.giaiphapexcel.com

Lập trình trong Power Query và các ví dụ

Lời tựa: Mấy năm gần đây, Power Query đã dần được sử dụng nhiều hơn mặc dù Microsoft (MS) đã hỗ trợ từ Excel 2010. Ở phạm vi diễn đàn, trên các kênh/ trang mạng hướng dẫn khác cũng có khá nhiều tài liệu, các ví dụ về lập trình trình trong Power Query. Power Query có hỗ trợ môi trường lập...
www.giaiphapexcel.com www.giaiphapexcel.com

Mấy cái lấy dữ liệu web thì cứ Python là tiện nhất.
Nhấp chuột vào đây để mở rộng...
Anh ơi Python thì nó có ngán cái gì đâu.
 
Upvote 0
Bạn xem thử.
Lưu ý, định dạng ngày bắt đầu và kết thúc.

PHP: 
Sub getmcp()
Dim pctCompl As Single
Dim IE As Object
Dim Arr
'----------------------------------------------
    'On Error Resume Next
    Set xmlReq = CreateObject("MSXML2.XMLHTTP")
    Set htmlDoc = CreateObject("HTMLFile")
    Set WS = Sheets("Chitiet")
    Set st = WS.Range("F3")
    Set en = WS.Range("I3")
    Set maCP = WS.Range("B3")
    If st = "" Or en = "" Or maCP = "" Then MsgBox "Nhap day du thong tin": Exit Sub
    lastRow = WS.Cells(Rows.Count, "B").End(xlUp).row
    If lastRow < 5 Then lastRow = 5
    WS.Range("A6:F" & lastRow).ClearContents
    stDate = DateSerial(Year(st), Month(st), Day(st))
    enDate = DateSerial(Year(en), Month(en), Day(en))
    For ngay = stDate To enDate
            lastRow = WS.Cells(Rows.Count, "B").End(xlUp).row
            If lastRow < 5 Then lastRow = 5
            URL = "https://s.cafef.vn/Lich-su-giao-dich-" & UCase(maCP) & "-6.chn?date=" & Format(ngay, "dd/mm/yyyu")
            With xmlReq
                .Open "GET", URL, False
                .Send
            End With
            Do While xmlReq.readyState <> 4 And xmlReq.Status <> 200
            Loop
                htmlDoc.body.innerHTML = xmlReq.responseText
                Set tblData = htmlDoc.getElementById("tblData")
                If tblData Is Nothing Then
                    Debug.Print "Item not found"
                Else
                    ReDim Arr(1 To tblData.Rows.Length, 1 To 5)
                    For i = 1 To tblData.Rows.Length
                        For j = 1 To 5
                            Arr(i, j) = tblData.Rows(i - 1).Cells(j - 1).outerText
                        Next j
                    Next i
                End If
'-------------------------
    WS.Range("A" & lastRow + 1) = ngay
    WS.Range("B" & lastRow + 1).Resize(UBound(Arr), 5) = Arr
'----------------------------------------------
    Next ngay
End Sub
 
Upvote 0
befaint đã viết:
Bạn không thiết lập 'time out', có lỗi kết nỗi thì 'nó' cứ đứng im mãi mãi.
Nhấp chuột vào đây để mở rộng...
bổ sung vào code dùm em vs bác, tks bác ạ
Bài đã được tự động gộp:

huhumalu đã viết:
Bạn xem thử.
Lưu ý, định dạng ngày bắt đầu và kết thúc.

PHP: 
Sub getmcp()
Dim pctCompl As Single
Dim IE As Object
Dim Arr
'----------------------------------------------
    'On Error Resume Next
    Set xmlReq = CreateObject("MSXML2.XMLHTTP")
    Set htmlDoc = CreateObject("HTMLFile")
    Set WS = Sheets("Chitiet")
    Set st = WS.Range("F3")
    Set en = WS.Range("I3")
    Set maCP = WS.Range("B3")
    If st = "" Or en = "" Or maCP = "" Then MsgBox "Nhap day du thong tin": Exit Sub
    lastRow = WS.Cells(Rows.Count, "B").End(xlUp).row
    If lastRow < 5 Then lastRow = 5
    WS.Range("A6:F" & lastRow).ClearContents
    stDate = DateSerial(Year(st), Month(st), Day(st))
    enDate = DateSerial(Year(en), Month(en), Day(en))
    For ngay = stDate To enDate
            lastRow = WS.Cells(Rows.Count, "B").End(xlUp).row
            If lastRow < 5 Then lastRow = 5
            URL = "https://s.cafef.vn/Lich-su-giao-dich-" & UCase(maCP) & "-6.chn?date=" & Format(ngay, "dd/mm/yyyu")
            With xmlReq
                .Open "GET", URL, False
                .Send
            End With
            Do While xmlReq.readyState <> 4 And xmlReq.Status <> 200
            Loop
                htmlDoc.body.innerHTML = xmlReq.responseText
                Set tblData = htmlDoc.getElementById("tblData")
                If tblData Is Nothing Then
                    Debug.Print "Item not found"
                Else
                    ReDim Arr(1 To tblData.Rows.Length, 1 To 5)
                    For i = 1 To tblData.Rows.Length
                        For j = 1 To 5
                            Arr(i, j) = tblData.Rows(i - 1).Cells(j - 1).outerText
                        Next j
                    Next i
                End If
'-------------------------
    WS.Range("A" & lastRow + 1) = ngay
    WS.Range("B" & lastRow + 1).Resize(UBound(Arr), 5) = Arr
'----------------------------------------------
    Next ngay
End Sub
Nhấp chuột vào đây để mở rộng...
e lấy phần tổng hợp thôi bác, code bác rất phần chi tiết rồi, phần tổng hợp nó ít dòng ,còn phần chi tiết nhiều dòng quá bác

tks bác
 
Lần chỉnh sửa cuối:
Upvote 0
ketoan113 đã viết:
e lấy phần tổng hợp thôi bác, code bác rất phần chi tiết rồi, phần tổng hợp nó ít dòng ,còn phần chi tiết nhiều dòng quá bác
tks bác
Nhấp chuột vào đây để mở rộng...
Chỉnh lại lấy thông tin từ bảng tổng hợp.
PHP: 
Sub getmcp()
    Dim Arr
    '----------------------------------------------
    'On Error Resume Next
    Set xmlReq = CreateObject("MSXML2.XMLHTTP")
    Set htmlDoc = CreateObject("HTMLFile")
    Set WS = Sheets("Chitiet")
    Set st = WS.Range("F3")
    Set en = WS.Range("I3")
    Set maCP = WS.Range("B3")
    If st = "" Or en = "" Or maCP = "" Then MsgBox "Nhap day du thong tin": Exit Sub
    lastRow = WS.Cells(Rows.Count, "B").End(xlUp).row
    If lastRow < 5 Then lastRow = 5
    WS.Range("A6:D" & lastRow).ClearContents
    stDate = DateSerial(Year(st), Month(st), Day(st))
    enDate = DateSerial(Year(en), Month(en), Day(en))
    For ngay = stDate To enDate
        lastRow = WS.Cells(Rows.Count, "B").End(xlUp).row
        If lastRow < 5 Then lastRow = 5
        If Weekday(ngay) <> vbSaturday And Weekday(ngay) <> vbSunday Then
            URL = "https://s.cafef.vn/Lich-su-giao-dich-" & UCase(maCP) & "-6.chn?date=" & Format(ngay, "dd/mm/yyyu")
            With xmlReq
                .Open "GET", URL, False
                .Send
            End With
            Do While xmlReq.readyState <> 4 And xmlReq.Status <> 200
            Loop
            htmlDoc.body.innerHTML = xmlReq.responseText
            Set tblData = htmlDoc.getElementById("tblStats")        '("tblData")
            If tblData Is Nothing Then
                Debug.Print "Item Not found"
            Else
                ReDim Arr(1 To tblData.Rows.Length, 1 To 3)
                For i = 1 To tblData.Rows.Length
                    For j = 1 To 3
                        Arr(i, j) = tblData.Rows(i - 1).Cells(j - 1).outerText
                    Next j
                Next i
            End If
            '-------------------------
            WS.Range("A" & lastRow + 1) = ngay
            WS.Range("B" & lastRow + 1).Resize(UBound(Arr), 3) = Arr
            '----------------------------------------------
        End If
    Next ngay
End Sub
 

File đính kèm

  • Chi tiet giao dich CK-GPE_rev.xlsm
    142.4 KB · Đọc: 22
Lần chỉnh sửa cuối:
Upvote 0
huhumalu đã viết:
Chỉnh lại lấy thông tin từ bảng tổng hợp.
PHP: 
Sub getmcp()
    Dim pctCompl    As Single
    Dim IE          As Object
    Dim Arr
    '----------------------------------------------
    'On Error Resume Next
    Set xmlReq = CreateObject("MSXML2.XMLHTTP")
    Set htmlDoc = CreateObject("HTMLFile")
    Set WS = Sheets("Chitiet")
    Set st = WS.Range("F3")
    Set en = WS.Range("I3")
    Set maCP = WS.Range("B3")
    If st = "" Or en = "" Or maCP = "" Then MsgBox "Nhap day du thong tin": Exit Sub
    lastRow = WS.Cells(Rows.Count, "B").End(xlUp).row
    If lastRow < 5 Then lastRow = 5
    WS.Range("A6:D" & lastRow).ClearContents
    stDate = DateSerial(Year(st), Month(st), Day(st))
    enDate = DateSerial(Year(en), Month(en), Day(en))
    For ngay = stDate To enDate
        lastRow = WS.Cells(Rows.Count, "B").End(xlUp).row
        If lastRow < 5 Then lastRow = 5
        If Weekday(ngay) <> vbSaturday And Weekday(ngay) <> vbSunday Then
            URL = "https://s.cafef.vn/Lich-su-giao-dich-" & UCase(maCP) & "-6.chn?date=" & Format(ngay, "dd/mm/yyyu")
            With xmlReq
                .Open "GET", URL, False
                .Send
            End With
            Do While xmlReq.readyState <> 4 And xmlReq.Status <> 200
            Loop
            htmlDoc.body.innerHTML = xmlReq.responseText
            Set tblData = htmlDoc.getElementById("tblStats")        '("tblData")
            If tblData Is Nothing Then
                Debug.Print "Item Not found"
            Else
                ReDim Arr(1 To tblData.Rows.Length, 1 To 3)
                For i = 1 To tblData.Rows.Length
                    For j = 1 To 3
                        Arr(i, j) = tblData.Rows(i - 1).Cells(j - 1).outerText
                    Next j
                Next i
            End If
            '-------------------------
            WS.Range("A" & lastRow + 1) = ngay
            WS.Range("B" & lastRow + 1).Resize(UBound(Arr), 3) = Arr
            '----------------------------------------------
        End If
    Next ngay
End Sub
Nhấp chuột vào đây để mở rộng...
em chào bác huhumalu,

em tải file về và test thấy ok, code tuyệt vời bác ạ

em cảm ơn bác, chúc bác nhiều sức khoẻ nhé bác
 
Lần chỉnh sửa cuối:
Upvote 0
Bài #10 cũng chưa hoàn thiện, vì còn ngày lễ, và chưa kể lỗi timeout, data rỗng.
 
Upvote 0
Sửa lại #10 vì lỗi lặp ngày; Bổ sung ghi chú ngày không giao dịch.
PHP: 
Sub getmcp()
    Dim Arr As Variant
    Dim xmlReq As Object, htmlDoc As Object
    'Dim st As String, en As String
    Dim maCP As String
    '----------------------------------------------
    'On Error Resume Next
    Set xmlReq = CreateObject("MSXML2.XMLHTTP")
    Set htmlDoc = CreateObject("HTMLFile")
    Set WS = Sheets("Chitiet")
    Set st = WS.Range("F3")
    Set en = WS.Range("I3")
    maCP = WS.Range("B3")
    If st = "" Or en = "" Or maCP = "" Then MsgBox "Nhap day du thong tin": Exit Sub
    lastRow = WS.Cells(Rows.Count, "B").End(xlUp).row
    If lastRow < 5 Then lastRow = 5
    WS.Range("A6:D" & lastRow).ClearContents
    stDate = DateSerial(Year(st), Month(st), Day(st))
    enDate = DateSerial(Year(en), Month(en), Day(en))
    For ngay = stDate To enDate
        lastRow = WS.Cells(Rows.Count, "B").End(xlUp).row
        If lastRow < 5 Then lastRow = 5
        If Weekday(ngay) <> vbSaturday And Weekday(ngay) <> vbSunday Then
            Url = "https://s.cafef.vn/Lich-su-giao-dich-" & UCase(maCP) & "-6.chn?date=" & Format(ngay, "dd/mm/yyyy")
            With xmlReq
                .Open "GET", Url, False
                .Send
            End With
            Do While xmlReq.readyState <> 4 And xmlReq.Status <> 200
            Loop
            htmlDoc.body.innerHTML = xmlReq.responseText
            If TypeName(htmlDoc.getElementById("tblStats")) = "HTMLTable" Then: Set tblData = htmlDoc.getElementById("tblStats")       '("tblData")
            If tblData Is Nothing Then
                Debug.Print "Item Not found"
                WS.Range("A" & lastRow + 1) = ngay
                WS.Range("B" & lastRow + 1) = "Ngày không giao d" & ChrW(7883) & "ch"
            Else
                ReDim Arr(1 To tblData.Rows.Length, 1 To 3)
                For i = 1 To tblData.Rows.Length
                    For j = 1 To 3
                        Arr(i, j) = tblData.Rows(i - 1).Cells(j - 1).outerText
                    Next j
                Next i
                WS.Range("A" & lastRow + 1) = ngay
                WS.Range("B" & lastRow + 1).Resize(UBound(Arr), 3) = Arr
            End If
            '----------------------------------------------
            Erase Arr
            Set tblData = Nothing
            '----------------------------------------------
        End If
    Next ngay
End Sub
 

File đính kèm

  • Chi tiet giao dich CK-GPE_rev2.xlsm
    164.1 KB · Đọc: 14
Upvote 0
huhumalu đã viết:
Bài #10 cũng chưa hoàn thiện, vì còn ngày lễ, và chưa kể lỗi timeout, data rỗng.
Nhấp chuột vào đây để mở rộng...

1.
#10 là sao bác nhỉ??

2.
các ngày không giao dịch có ngày lễ (2/9; 30/4; tết tây, giỗ tổ hùng vương, t7, cn, ngày nghỉ lễ bù...)
những ngày ko có giao dịch thì ko có data hiển thị cũng dc nè bác

vd e gõ mà CTG , ngày 12/11/2022 đến 13/11/2022 : ko có giao dịch nên ko có data

3.
có lỗi xảy ra nhé bác, vd em gõ ngày hôm nay 15/11/2022 (tất nhien là phải gõ khi chưa có giao dịch, chưa có data, tt ck giao dịch từ 9h sáng) thì ngày 15/11/2022 nó lại lấy data ngày 14/11/2022
bác xem fix dc lỗi ko ạ? tks bác
 

File đính kèm

  • Chi tiet giao dich CK-GPE_rev2.xlsm
    143.2 KB · Đọc: 2
Lần chỉnh sửa cuối:
Upvote 0
Update 15/11 (rev3)
+ Bổ sung hyperlink dẫn đến Website --> kiểm tra đối chiếu.
+ Bỏ dòng header khối dữ liệu hàng ngày.
+ Sửa lỗi lặp ngày.
+ Cập nhật kiểm tra giờ mở phiên (09:00AM)
 

File đính kèm

  • Chi tiet giao dich CK-GPE_rev3.xlsm
    144.6 KB · Đọc: 9
Upvote 0
huhumalu đã viết:
Update 15/11 (rev3)
+ Bổ sung hyperlink dẫn đến Website --> kiểm tra đối chiếu.
+ Bỏ dòng header khối dữ liệu hàng ngày.
+ Sửa lỗi lặp ngày.
+ Cập nhật kiểm tra giờ mở phiên (09:00AM)
Nhấp chuột vào đây để mở rộng...
hi bác huhumalu
em chân thành cảm ơn bác
em test thấy vd em gõ ngày bắt đầu = 01/01/2022 thì code bị lỗi ạ
bác check dùm em với

cảm ơn bác
 

File đính kèm

  • Chi tiet giao dich CK-GPE_rev3.xlsm
    141.1 KB · Đọc: 2
Upvote 0
PHP: 
Sub getmcp()
    Dim Arr As Variant
    Dim xmlReq As Object, htmlDoc As Object
    'Dim st As String, en As String
    Dim maCP As String
    '----------------------------------------------
    'On Error Resume Next
    Set xmlReq = CreateObject("MSXML2.XMLHTTP")
    Set htmlDoc = CreateObject("HTMLFile")
    Set WS = Sheets("Chitiet")
    Set st = WS.Range("F3")
    Set en = WS.Range("I3")
    dtToday = DateSerial(Year(Date), Month(Date), Day(Date))
    maCP = WS.Range("B3")
    If st = "" Or en = "" Or maCP = "" Then MsgBox "Nhap day du thong tin": Exit Sub
    lastRow = WS.Cells(Rows.Count, "B").End(xlUp).row
    If lastRow < 5 Then lastRow = 5
    WS.Range("A6:D" & lastRow).ClearContents
    stDate = DateSerial(Year(st), Month(st), Day(st))
    enDate = DateSerial(Year(en), Month(en), Day(en))
    For ngay = stDate To enDate
        lastRow = WS.Cells(Rows.Count, "B").End(xlUp).row
        If lastRow < 5 Then lastRow = 5
        If ngay < dtToday Or (ngay = dtToday And TimeValue(Now) > TimeValue("09:00:00")) Then
            Url = "https://s.cafef.vn/Lich-su-giao-dich-" & UCase(maCP) & "-6.chn?date=" & Format(ngay, "dd/mm/yyyy")
            With xmlReq
                .Open "GET", Url, False
                .Send
            End With
            Do While xmlReq.readyState <> 4 And xmlReq.Status <> 200
            Loop
            htmlDoc.body.innerHTML = xmlReq.responseText
            WS.Range("A" & lastRow + 1) = "=HYPERLINK(""" & Url & """,""" & ngay & """)"
            If TypeName(htmlDoc.getElementById("tblStats")) <> "HTMLTable" Or Weekday(ngay) = vbSaturday Or Weekday(ngay) = vbSunday Then
                Debug.Print "Item Not found"
                WS.Range("B" & lastRow + 1) = "Ngày không giao d" & ChrW(7883) & "ch"
            Else
                Set tblData = htmlDoc.getElementById("tblStats")       '("tblData")
                ReDim Arr(1 To tblData.Rows.Length - 1, 1 To 3)
                For i = 1 To tblData.Rows.Length - 1
                    For j = 1 To 3
                        Arr(i, j) = tblData.Rows(i).Cells(j - 1).outerText
                    Next j
                Next i
                WS.Range("B" & lastRow + 1).Resize(UBound(Arr), 3) = Arr
                Erase Arr
            End If
            '----------------------------------------------
            
            Set tblData = Nothing
            '----------------------------------------------
        End If
    Next ngay
End Sub

Bạn tải lại file đính kèm.
 

File đính kèm

  • Chi tiet giao dich CK-GPE_rev4.xlsm
    147.6 KB · Đọc: 26
Upvote 0
huhumalu đã viết:
PHP: 
Sub getmcp()
    Dim Arr As Variant
    Dim xmlReq As Object, htmlDoc As Object
    'Dim st As String, en As String
    Dim maCP As String
    '----------------------------------------------
    'On Error Resume Next
    Set xmlReq = CreateObject("MSXML2.XMLHTTP")
    Set htmlDoc = CreateObject("HTMLFile")
    Set WS = Sheets("Chitiet")
    Set st = WS.Range("F3")
    Set en = WS.Range("I3")
    dtToday = DateSerial(Year(Date), Month(Date), Day(Date))
    maCP = WS.Range("B3")
    If st = "" Or en = "" Or maCP = "" Then MsgBox "Nhap day du thong tin": Exit Sub
    lastRow = WS.Cells(Rows.Count, "B").End(xlUp).row
    If lastRow < 5 Then lastRow = 5
    WS.Range("A6:D" & lastRow).ClearContents
    stDate = DateSerial(Year(st), Month(st), Day(st))
    enDate = DateSerial(Year(en), Month(en), Day(en))
    For ngay = stDate To enDate
        lastRow = WS.Cells(Rows.Count, "B").End(xlUp).row
        If lastRow < 5 Then lastRow = 5
        If ngay < dtToday Or (ngay = dtToday And TimeValue(Now) > TimeValue("09:00:00")) Then
            Url = "https://s.cafef.vn/Lich-su-giao-dich-" & UCase(maCP) & "-6.chn?date=" & Format(ngay, "dd/mm/yyyy")
            With xmlReq
                .Open "GET", Url, False
                .Send
            End With
            Do While xmlReq.readyState <> 4 And xmlReq.Status <> 200
            Loop
            htmlDoc.body.innerHTML = xmlReq.responseText
            WS.Range("A" & lastRow + 1) = "=HYPERLINK(""" & Url & """,""" & ngay & """)"
            If TypeName(htmlDoc.getElementById("tblStats")) <> "HTMLTable" Or Weekday(ngay) = vbSaturday Or Weekday(ngay) = vbSunday Then
                Debug.Print "Item Not found"
                WS.Range("B" & lastRow + 1) = "Ngày không giao d" & ChrW(7883) & "ch"
            Else
                Set tblData = htmlDoc.getElementById("tblStats")       '("tblData")
                ReDim Arr(1 To tblData.Rows.Length - 1, 1 To 3)
                For i = 1 To tblData.Rows.Length - 1
                    For j = 1 To 3
                        Arr(i, j) = tblData.Rows(i).Cells(j - 1).outerText
                    Next j
                Next i
                WS.Range("B" & lastRow + 1).Resize(UBound(Arr), 3) = Arr
                Erase Arr
            End If
            '----------------------------------------------
           
            Set tblData = Nothing
            '----------------------------------------------
        End If
    Next ngay
End Sub

Bạn tải lại file đính kèm.
Nhấp chuột vào đây để mở rộng...
cột ngày (Cột A) bác định dạng cho em chữ nghiêng luôn dc ko ạ?

cảm ơn bác
 

File đính kèm

  • Chi tiet giao dich CK-GPE_rev4.xlsm
    145.1 KB · Đọc: 9
Upvote 0
Bạn tự định dạng nguyên cột A được mà, đâu có nhất thiết phải can thiệp bằng công cụ khác.
Quan trọng bạn cứ chạy thử, các trường hợp, xem thử còn lỗi gì nữa không để chỉnh. Còn lại format này nọ làm trong bảng tính cũng được.
 
Upvote 0
huhumalu đã viết:
Bạn tự định dạng nguyên cột A được mà, đâu có nhất thiết phải can thiệp bằng công cụ khác.
Quan trọng bạn cứ chạy thử, các trường hợp, xem thử còn lỗi gì nữa không để chỉnh. Còn lại format này nọ làm trong bảng tính cũng được.
Nhấp chuột vào đây để mở rộng...
dạ vâng
để em test xem có lỗi j nữa không, có j em báo
tks bác huhumalu nhiều ạ
 
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

N
Giúp em hàm Aggregate không chạy được trên Google sheet ah
Trả lời
0
Đọc
1
nguyenthieny
N
Huy@@*
Tách NKC Nhiều nợ, nhiều có VBA
Trả lời
3
Đọc
65
Hoàng Tuấn 868
H
Huy@@*
Giải đáp giùm em, cách khắc phục lỗi này trên VBA
2
Trả lời
20
Đọc
236
nttrung_proneu
nttrung_proneu
Bùi Thúy Thúy
  • Question
Lấy dữ liệu thời tiết Accuweather để điền vào nhật ký thi công
2 3 4
Trả lời
62
Đọc
18K
HeSanbi
HeSanbi
B
Nhờ anh/chị giúp em tìm hàm cho công thức tính lương
Trả lời
0
Đọc
30
Bobomkkk
B
ongke0711
  • Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
7 8 9
Trả lời
174
Đọc
9K
tienphat85
tienphat85
H
Timesheet: Excel hay Power Apps/ Forms? Cách sắp xếp dữ liệu?
Trả lời
4
Đọc
345
duykhanh3488
D
vova2209
Index kết hợp với match 2 điều kiện
Trả lời
14
Đọc
1K
dunghtgiga
dunghtgiga
D
  • Question
Xin cách tạo tab và button cho Add-in trên ribbon Maintabs
Trả lời
2
Đọc
77
Decepticon
D
N
cộng các dữ liệu không trùng nhau
Trả lời
12
Đọc
185
Nguyễn Hiền1508
N
E
  • Question
Tạo bảng lọc theo điều kiện
Trả lời
2
Đọc
66
Excel my love_1
E
T
Chèn dữ liệu từ sheet này qua sheet khác theo điều kiện
Trả lời
3
Đọc
120
HieuCD
H
T
Trùng 2 lần: Tìm dữ liệu nhiều điều kiện
Trả lời
0
Đọc
69
Thulib
T
N
  • Question
Xin mã code ẩn hiện dòng theo điều kiện
Trả lời
10
Đọc
107
Nguyễn Diêu Hiền
N
K
  • Question
Sử dụng Power Query để xử lý nhật ký chung nhiều nợ nhiều có
    • Cười
Trả lời
11
Đọc
193
quocphuoc88
quocphuoc88
N
Công thức tính số phù hợp với % mong muốn
Trả lời
9
Đọc
156
CHAOQUAY
C
B
Giúp em xử lý lỗi macro khi chạy VBA
2
Trả lời
21
Đọc
448
huhumalu
H
hunganh.nguyen
Xin giúp code tách dòng tổng thành những dòng chi tiết với giá trị là 1
Trả lời
6
Đọc
332
DeTong
D
T
cả nhà hỗ trợ giúp em là em phải dùng hàm gì cho đúng ạ, em làm mãi không được
    • Cười
Trả lời
2
Đọc
97
DeTong
D
nguyenanhhoa
Nhờ các bác giúp: e muốn tô màu khác nhau đối với các ô giống nhau về giá trị
    • Cười
Trả lời
7
Đọc
140
SA_DQ
SA_DQ
Xem thêm…

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