Tải kết quả xổ số miền Bắc về Excel

Quảng cáo

CHAOQUAY

Thành viên tích cực
Tham gia ngày
24 Tháng tám 2018
Bài viết
1,385
Được thích
1,506
Điểm
668
Để chạy được file này, cần làm như sau:
Nhấn alt+F11
Nhấn alt+T+R -> tìm & tích chọn các mục như hình trong sheet "Hd" -> OK -> alt+Q.
Chuyển sang sheet "capnhat", thực hiện theo hướng dẫn bên trong.
---
File này lấy kết quả miền Bắc từ trang ketqua.net.
Các ngày nghỉ tết, nghỉ dịch ...là những ngày không có kết quả -> không thống kê.
 

File đính kèm

  • KetquaMienBac.xlsb
    191 KB · Đọc: 55

Gà Công Nghệ

꧁☆☬GPE☬☆꧂
Tham gia ngày
11 Tháng tám 2015
Bài viết
695
Được thích
333
Điểm
468
Để chạy được file này, cần làm như sau:
Nhấn alt+F11
Nhấn alt+T+R -> tìm & tích chọn các mục như hình trong sheet "Hd" -> OK -> alt+Q.
Chuyển sang sheet "capnhat", thực hiện theo hướng dẫn bên trong.
---
File này lấy kết quả miền Bắc từ trang ketqua.net.
Các ngày nghỉ tết, nghỉ dịch ...là những ngày không có kết quả -> không thống kê.
Hay quá, không biết có xổ số miền nam không bạn.
 

nimbus99

Thành viên mới
Tham gia ngày
13 Tháng tám 2019
Bài viết
2
Được thích
3
Điểm
103
Tuổi
26
Đợt này hơi bận, sắp tới rảnh sẽ làm miền trung & miền nam luôn thể
Cám ơn tác giả.

Có 1 bug nhỏ là khi gặp ngày không sổ xố. Ví dụ trong tháng 4 vừa qua. Trang kết quả sổ xố vẫn hiện 31/3/2020. Cho nên maxNgay không nhảy. thành ra script cứ tải hoài ngày 1/4/2020 đến vô tận.
Để giải quyết, mình cho result (1,1) thành ngày (bằng J3). Và dời td đầu tiên qua result (1,2) thì không bị vướng nữa.
Cái này có lợi là mình có 2 cell chứa date để sau này compare. Nếu không match thì coi như ngày đó không xổ và xóa ra khỏi database.

Mình thích miền nam nên chỉnh thành miền nam.

Mã:
# add thêm ngày vào result(1,2)

                For Each resR In resT.Rows
                    
                    
                    If i = 1 Then
                        
                        result(1, 1) = Sheet1.Range("J3")
                        j = 1
                        For Each cll In resR.Cells
                            
                            If j = 1 Then
                                firstLine = cll.innerText
                                
                                namLoc = InStr(1, firstLine, vbNewLine)
                                result(i, j + 1) = Right(firstLine, Len(firstLine) - namLoc - 1)
                                
                                
                            Else
                                result(i, j + 1) = cll.innerText


                                j = j + 1
                            End If
                        Next cll ......

File Miền Nam mình lấy mọi đài cho vào database, sau này dùng hàm filter nó sau.

Miền trung thì chỉ cần đổi

Mã:
.Open "GET", "http://ketqua.net/xo-so-mien-nam.php?ngay=" & Sheet1.Range("J3"), False

thành
.Open "GET", "http://ketqua.net/xo-so-mien-trung.php?ngay=" & Sheet1.Range("J3"), False
 

File đính kèm

  • KetquaMienNam - 31-01-2016.xlsb
    671.5 KB · Đọc: 10

CHAOQUAY

Thành viên tích cực
Tham gia ngày
24 Tháng tám 2018
Bài viết
1,385
Được thích
1,506
Điểm
668
Cám ơn tác giả.

Có 1 bug nhỏ là khi gặp ngày không sổ xố. Ví dụ trong tháng 4 vừa qua. Trang kết quả sổ xố vẫn hiện 31/3/2020. Cho nên maxNgay không nhảy. thành ra script cứ tải hoài ngày 1/4/2020 đến vô tận.
Để giải quyết, mình cho result (1,1) thành ngày (bằng J3). Và dời td đầu tiên qua result (1,2) thì không bị vướng nữa.
Cái này có lợi là mình có 2 cell chứa date để sau này compare. Nếu không match thì coi như ngày đó không xổ và xóa ra khỏi database.

Mình thích miền nam nên chỉnh thành miền nam.

Mã:
# add thêm ngày vào result(1,2)

                For Each resR In resT.Rows
                   
                   
                    If i = 1 Then
                       
                        result(1, 1) = Sheet1.Range("J3")
                        j = 1
                        For Each cll In resR.Cells
                           
                            If j = 1 Then
                                firstLine = cll.innerText
                               
                                namLoc = InStr(1, firstLine, vbNewLine)
                                result(i, j + 1) = Right(firstLine, Len(firstLine) - namLoc - 1)
                               
                               
                            Else
                                result(i, j + 1) = cll.innerText


                                j = j + 1
                            End If
                        Next cll ......

File Miền Nam mình lấy mọi đài cho vào database, sau này dùng hàm filter nó sau.

Miền trung thì chỉ cần đổi

Mã:
.Open "GET", "http://ketqua.net/xo-so-mien-nam.php?ngay=" & Sheet1.Range("J3"), False

thành
.Open "GET", "http://ketqua.net/xo-so-mien-trung.php?ngay=" & Sheet1.Range("J3"), False
Từ ngày 1/4 đến 22/4 miền Bắc nghỉ dịch covid19, đến ngày 23/4 lại có trở lại. Trong những ngày nghỉ, dòng cuối sẽ hiển thị chuỗi ngày tháng nối liền, hết ngày nghỉ sẽ lại chạy bình thường. Trên máy tôi chạy không bị lặp vô tận bạn ah.

---
Cám ơn bạn đã bổ sung miền Trung & miền Nam
 

nimbus99

Thành viên mới
Tham gia ngày
13 Tháng tám 2019
Bài viết
2
Được thích
3
Điểm
103
Tuổi
26
Từ ngày 1/4 đến 22/4 miền Bắc nghỉ dịch covid19, đến ngày 23/4 lại có trở lại. Trong những ngày nghỉ, dòng cuối sẽ hiển thị chuỗi ngày tháng nối liền, hết ngày nghỉ sẽ lại chạy bình thường. Trên máy tôi chạy không bị lặp vô tận bạn ah.

---
Cám ơn bạn đã bổ sung miền Trung & miền Nam
Đúng rồi, miền Bắc không có cho kết quả nếu không xổ, chỉ có 1 dòng thông báo.
Miền Trung và miền Nam thì trang web nào (như minhngoc cũng vậy) đều để kết quả ngày cũ 31/3, nên mới bị loop.
 
Quảng cáo
Top Bottom