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

[msfbtvt]

Bác @CHAOQUAY ạ E xóa dòng này đi thì chạy được nhưng kết quả chỉ dc giải đặc biệt và nhất

result(i, z + 1) = Mid(t, (z - 1) * eNs(i - 3) + 1, eNs(i - 3))

 

[cuoi123]

Đúng là minh cũng gặp lỗi này ấn vào debug thì nó báo dòng: result(i, z + 1) = Mid(t, (z - 1) * eNs(i - 3) + 1, eNs(i - 3))
mình tưởng là font ngày nhưng không phải ~~

Bác ơi e chạy file đầu tiên của bác ở đầu bài viết

View attachment 258418

E chọn cái ngày này đổi từ 01-01-20 về 01-01-05

Khi ấn nút capnhat thì bảng báo lỗi như sau

Bác giúp e với ạ

View attachment 258419

 

[msfbtvt]

Đúng là minh cũng gặp lỗi này ấn vào debug thì nó báo dòng: result(i, z + 1) = Mid(t, (z - 1) * eNs(i - 3) + 1, eNs(i - 3))
mình tưởng là font ngày nhưng không phải ~~

Mình nghĩ là lỗi index khi list giá trị vào ô
Mà mình ko biết sửa
Chờ bác thớt hướng dẫn vậy

 

[CHAOQUAY]

Bác @CHAOQUAY ạ E xóa dòng này đi thì chạy được nhưng kết quả chỉ dc giải đặc biệt và nhất

result(i, z + 1) = Mid(t, (z - 1) * eNs(i - 3) + 1, eNs(i - 3))

View attachment 259676

Bạn chạy file này, cập nhật số liệu của vài ngày bắt đầu từ 1/1/2005 rồi gửi lại để xem số liệu thế nào rồi tính tiếp

 

[msfbtvt]

nó báo lỗi này bác ạ
result(i, z + 1) = t

 

[tuongnguyen8486]

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.

# 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

.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 miền Nam thống kê dòng không được bác ơi, bác giúp em với. Tks bác a.

 

[CHAOQUAY]

nó báo lỗi này bác ạ
result(i, z + 1) = t

View attachment 259691

Để 2, 3 hôm tới rảnh sẽ kiểm tra lại lỗi này rồi báo lại bạn

 

[tuongnguyen8486]

Để 2, 3 hôm tới rảnh sẽ kiểm tra lại lỗi này rồi báo lại bạn

bác có thẻ cho em file dữ liệu kết quả miền nam ko ạ, tks bác

 

[msfbtvt]

Để 2, 3 hôm tới rảnh sẽ kiểm tra lại lỗi này rồi báo lại bạn

vâng bác, bọn e chờ tin bác ạ

 

[yeuemuconlau]

vâng bác, bọn e chờ tin bác ạ

Hóng, mình cũng lỗi tương tự, i sì phooc luôn

 

[Xuân Voi]

Hóng, mình cũng lỗi tương tự, i sì phooc luôn

Đã sửa lỗi ...
Gửi cho anh chị em cùng niềm đam mê số học
Code đã chỉnh sửa và bẩy lỗi những ngày không về
Tải về vào Sheet "data" nhấn cập nhật là ok.
Cập nhật từ 2010 đến nay, Sẽ mất thời gian khá lâu nên ACE nên cập nhật vào lúc máy mình không làm gì nhé
Sau lần đầu thì hàng ngày cứ nhấn UPDATE là Ô XÌ KE.

 

[msfbtvt]

Gửi cho anh chị em cùng niềm đam mê số học
Code đã chỉnh sửa và bẩy lỗi những ngày không về
Tải về vào Sheet "data" nhấn cập nhật là ok.
Cập nhật từ 2010 đến nay, Sẽ mất thời gian khá lâu nên ACE nên cập nhật vào lúc máy mình không làm gì nhé
Sau lần đầu thì hàng ngày cứ nhấn UPDATE là Ô XÌ KE.

Thank bác nhiều ah
Máy e chạy thì nó báo lỗi này

MgPaste(Hg, Cot) = Mid(result(Ro, 2), Col, 4)

 

[Xuân Voi]

Thank bác nhiều ah
Máy e chạy thì nó báo lỗi này

MgPaste(Hg, Cot) = Mid(result(Ro, 2), Col, 4)

View attachment 260535

Ok nhé tải về chạy bình thường

Thêm dữ liệu từ 01/01/2010 Của tất cả các đài miền nam cho đến ngày 11/06/2021 cho ai cần
miền trung data...

 

[msfbtvt]

Ok nhé tải về chạy bình thường

Thêm dữ liệu từ 01/01/2010 Của tất cả các đài miền nam cho đến ngày 11/06/2021 cho ai cần
miền trung data...

bác ơi. thật phiền bác qá, e chạy vẫn bị lỗi kia ạ! T__T

 

[leadlong1422]

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.

# 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

.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

chào anh. trang web thay đổi định dạng hay sao vậy mà file bị lỗi run time rồi ah. a sửa giúp em với

 

[zPeterPan]

chào anh. trang web thay đổi định dạng hay sao vậy mà file bị lỗi run time rồi ah. a sửa giúp em với

trang web ketqua.net đang bị khóa mà bác

Bài đã được tự động gộp: 22/6/21

bác @CHAOQUAY có thể sửa để lấy từ web khác không ạ. . . chứ web ketqua.net bị khóa rồi ạ

 

[leadlong1422]

trang web ketqua.net đang bị khóa mà bác

Bài đã được tự động gộp: 22/6/21

bác @CHAOQUAY có thể sửa để lấy từ web khác không ạ. . . chứ web ketqua.net bị khóa rồi ạ

trang này uy tín lâu năm lắm rồi chắc là bảo trì thôi. em nghĩ nó không bị khoá đâu. mà mới bị khoá thôi, chắc được 3 ngày

 

[zPeterPan]

trang này uy tín lâu năm lắm rồi chắc là bảo trì thôi. em nghĩ nó không bị khoá đâu. mà mới bị khoá thôi, chắc được 3 ngày

ketqua.net giờ sửa thành ketqua1.net bác ạ

 

[CHAOQUAY]

ketqua.net giờ sửa thành ketqua1.net bác ạ

Nhấn alt+F11, kích đúp vào "A_Capnhat", tìm dòng trên thêm số 1 cho thành dòng dưới

'.Open "GET", "http://ketqua.net/xo-so-truyen-thong.php?ngay=" & Sheet1.Range("J3"), False
.Open "GET", "http://ketqua1.net/xo-so-truyen-thong.php?ngay=" & Sheet1.Range("J3"), False

 

[zPeterPan]

Bác @CHAOQUAY bác có thể sửa định dạng cột A và cột B theo như hình được không ạ