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

CHAOQUAY · 11/9/21

doccohaiau đã viết:
@CHAOQUAY
@xuantuong.ktv
về vấn đề bẫy lỗi trên ketqua1.net thuật toán như sau: (ai cần thì làm nhé chứ m ko lấy bên ketqua1 )
1. Lấy ngày cuối cùng của các đài (dùng link ko có ngày nhé) gán vào 1 biến
2. Kiểm tra ngày max nếu = ngày cuối thì exit do

Mã:

If CDate(Mid(ResGetN, 7, 10)) = MinhNgoc.Range("B11").Value Then Exit Do '//////////////// thêm dòng này Loop End With End If End Sub

Chỉ có sửa thế thôi
Vì cái này m tạo thử trên minhngoc nhưng cũng chỉ bỏ qua ngày cuối THEO ĐÀI như miền nam hiện nay.
Còn đoạn nghỉ ở giữa nghe hơi căng. Thuật toán có mà chưa biết viết code thế nào .
Khó quá có khi quay sang kiểu lấy THEO MIỀN xem

Trang Minh Ngọc lấy theo miền có lẽ tiện hơn đấy bạn.
Tôi hiện tại xem miền Bắc là chính, chắc có lẽ sắp tới thử luôn cả Trung & Nam cho nó đủ cơm canh

doccohaiau · 11/9/21

CHAOQUAY đã viết:
Trang Minh Ngọc lấy theo miền có lẽ tiện hơn đấy bạn.
Tôi hiện tại xem miền Bắc là chính, chắc có lẽ sắp tới thử luôn cả Trung & Nam cho nó đủ cơm canh

Nghĩ kỹ rồi lấy theo miền lại mất công sửa code. tác dụng hiện tại thôi b ơi.
Giờ miền nam đang nghỉ. chứ nó quay lại thì lại dính lỗi như cái như cái theo đài.
Chẳng lẽ lúc đó lại sửa code né đoạn ngày nghỉ ra à b. xong nó nhiều đoạn ngày nghi thì lại quá tội

doccohaiau · 12/9/21

Viết rồi thì post cho ae tham khảo nhỉ

.Mấy hôm trước chơi thủ công bằng hàm trên xel

. Nay mới viết ra xem có ngộ ra cái gì cho loop ko

Tác dụng nhất là khi lấy đài miền nam - trung. để hạn chế vòng lặp thôi.

Nghỉ = N; Quay = Q ví dụ đài Đà Nẵng mở thứ 4 - 7 thì: Lich= "NNNQNNQ". Tính từ CN đến Thứ 7
Fun-NgayStart là tính ngày đầu tiên khi đài bắt đầu quay
Fun-NgayNext là tính ngày tiếp tiêp khi đã có ngày bắt đầu quay

Fun-NgayStart

Mã:

Function NgayStart(Ngay As Date, Lich As String) As Date ''LICH = CHUOI NEU NGHI =N NEU QUAY = Q
    Dim Arr(6, 3) As Variant
    Dim i, k As Integer
    Dim MinNgay As Date, m As Integer
    For i = 1 To 7
        k = i - 1
        Arr(k, 0) = i
        If Mid(Lich, i, 1) = "Q" Then Arr(k, 1) = True Else Arr(k, 1) = False
        If Weekday(Ngay) <= i Then Arr(k, 2) = i - Weekday(Ngay) Else Arr(k, 2) = 7 + i - Weekday(Ngay)
        If Arr(k, 1) = False Then Arr(k, 3) = "Nghi" Else Arr(k, 3) = Ngay + Arr(k, 2)
    Next i
    MinNgay = 0
    For m = 0 To 6
        If IsDate(Arr(m, 3)) = True Then
            If Arr(m, 3) - Ngay = 0 Then MinNgay = Ngay
            If Arr(m, 3) - Ngay > 0 Then
                If MinNgay = 0 Then MinNgay = Arr(m, 3)
                If MinNgay <> 0 Then
                    If MinNgay - Arr(m, 3) > 0 Then MinNgay = Arr(m, 3)
                    If MinNgay - Arr(m, 3) <= 0 Then MinNgay = MinNgay
                End If
            End If
        End If
    Next m
    NgayStart = MinNgay
End Function

Fun-NgayNext

Mã:

Function NgayNext(Ngay As Date, Lich As String) As Date ''LICH = CHUOI NEU NGHI =N NEU QUAY = Q
    Dim Arr(6, 3) As Variant
    Dim i, k As Integer
    Dim MinNgay As Date, m As Integer
    For i = 1 To 7
        k = i - 1
        Arr(k, 0) = i
        If Mid(Lich, i, 1) = "Q" Then Arr(k, 1) = True Else Arr(k, 1) = False
        If Weekday(Ngay) < i Then Arr(k, 2) = i - Weekday(Ngay) Else Arr(k, 2) = 7 + i - Weekday(Ngay)
        If Arr(k, 1) = False Then Arr(k, 3) = "Nghi" Else Arr(k, 3) = Ngay + Arr(k, 2)
    Next i
    MinNgay = 0
    For m = 0 To 6
        If IsDate(Arr(m, 3)) = True Then
            If Arr(m, 3) - Ngay = 0 Then MinNgay = Ngay
            If Arr(m, 3) - Ngay > 0 Then
                If MinNgay = 0 Then MinNgay = Arr(m, 3)
                If MinNgay <> 0 Then
                    If MinNgay - Arr(m, 3) > 0 Then MinNgay = Arr(m, 3)
                    If MinNgay - Arr(m, 3) <= 0 Then MinNgay = MinNgay
                End If
            End If
        End If
    Next m
    NgayNext = MinNgay
End Function

Code chỉ khác nhau 1 cái dấu "=" thôi nhé

.

doccohaiau · 13/9/21

Cuối cùng cũng xong

. Đã fix lỗi nghỉ. mà ko biết đúng hết chưa

B nào dùng thử thì cho m biết xem có lỗi gì ko nhé.
Code chưa được sạch sẽ lắm

.
Há há ko dùng được chung cho miền bắc. miền bắc chỉ lấy theo đài được
Thêm cái bộ dưới cho đẹp

. Độ chính tên đài neu bi lỗi thì ktra lại nhé. M lấy từ nguồn .php của ketqua1

Mã:

mien-trung    binh-dinh    NNNNQNN    18
mien-trung    da-nang    NNNQNNQ    18
mien-trung    dac-lac    NNQNNNN    18
mien-trung    dac-nong    NNNNNNQ    18
mien-trung    gia-lai    NNNNNQN    18
mien-trung    thua-thien-hue    NQNNNNN    18
mien-trung    quang-tri    NNNNQNN    18
mien-trung    quang-ngai    NNNNNNQ    18
mien-trung    quang-nam    NNQNNNN    18
mien-trung    quang-binh    NNNNQNN    18
mien-trung    phu-yen    NQNNNNN    18
mien-trung    ninh-thuan    NNNNNQN    18
mien-trung    kon-tum    QNNNNNN    18
mien-trung    khanh-hoa    QNNQNNN    18
mien-nam    an-giang    NNNNQNN    17
mien-nam    bac-lieu    NNQNNNN    17
mien-nam    ben-tre    NNQNNNN    17
mien-nam    binh-duong    NNNNNQN    17
mien-nam    binh-phuoc    NNNNNNQ    17
mien-nam    binh-thuan    NNNNQNN    17
mien-nam    ca-mau    NQNNNNN    17
mien-nam    can-tho    NNNQNNN    17
mien-nam    da-lat    QNNNNNN    17
mien-nam    dong-nai    NNNQNNN    17
mien-nam    dong-thap    NQNNNNN    17
mien-nam    hau-giang    NNNNNNQ    17
mien-nam    ho-chi-minh    NQNNNNQ    17
mien-nam    kien-giang    QNNNNNN    17
mien-nam    long-an    NNNNNNQ    17
mien-nam    soc-trang    NNNQNNN    17
mien-nam    tay-ninh    NNNNQNN    17
mien-nam    tien-giang    QNNNNNN    17
mien-nam    tra-vinh    NNNNNQN    17
mien-nam    vinh-long    NNNNNQN    17
mien-nam    vung-tau    NNQNNNN    17

quanluu · 13/9/21

Tiện đây anh em cho hỏi, làm sao mình lấy được dữ liệu trang này theo số ngày nhỉ? mình code mà nó trả về responseText không đúng nguồn của web nên không lấy được data.

Mã:

    With xmlReq
        .Open "POST","http://ketqua1.net/cau-loto", False
        .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"      
        .send "code=mb&end_date=11-9-2021&count=5"
    End With

doccohaiau · 13/9/21

quanluu đã viết:
Tiện đây anh em cho hỏi, làm sao mình lấy được dữ liệu trang này theo số ngày nhỉ? mình code mà nó trả về responseText không đúng nguồn của web nên không lấy được data.

Mã:

With xmlReq .Open "POST","http://ketqua1.net/cau-loto", False .setRequestHeader "Content-Type", "application/x-www-form-urlencoded" .send "code=mb&end_date=11-9-2021&count=5" End With

Mã:

Sub httpPost()
    Dim xmlHTTP As New XMLHTTP60, HTMdoc As New HTMLDocument
    Dim post As Object, ResGetG() As String
With xmlHTTP
        .Open "POST", "http://ketqua1.net/cau-loto", False
        '.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/59.0.3071.115 Safari/537.36"
        .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
        .send "code=mb&end_date=11-9-2021&count=3"
        HTMdoc.body.innerHTML = .responseText
End With
ReDim ResGetG(1 To 2, 1 To 1) As String
    For Each post In HTMdoc.getElementsByClassName("table")
        With post.getElementsByTagName("tbody")
            If .Length Then
                Row = Row + 1
                'Cells(Row, 1) = .Item(0).innerText
                If Row = 1 Then ResGetG(1, 1) = .Item(0).innerText      ' theo lo
                If Row = 2 Then ResGetG(2, 1) = .Item(0).innerText      ' theo lo cap
            End If
        End With
    Next post
    Me.Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(2, 1) = ResGetG
    'Me.Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(2, 1).WrapText = 0
End Sub

vẫn ra đúng mà nhỉ

quanluu · 13/9/21

doccohaiau đã viết:

Mã:

Sub httpPost()
    Dim xmlHTTP As New XMLHTTP60, HTMdoc As New HTMLDocument
    Dim post As Object, ResGetG() As String
With xmlHTTP
        .Open "POST", "http://ketqua1.net/cau-loto", False
        '.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/59.0.3071.115 Safari/537.36"
        .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
        .send "code=mb&end_date=11-9-2021&count=3"
        HTMdoc.body.innerHTML = .responseText
End With
ReDim ResGetG(1 To 2, 1 To 1) As String
    For Each post In HTMdoc.getElementsByClassName("table")
        With post.getElementsByTagName("tbody")
            If .Length Then
                Row = Row + 1
                'Cells(Row, 1) = .Item(0).innerText
                If Row = 1 Then ResGetG(1, 1) = .Item(0).innerText      ' theo lo
                If Row = 2 Then ResGetG(2, 1) = .Item(0).innerText      ' theo lo cap
            End If
        End With
    Next post
    Me.Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(2, 1) = ResGetG
    'Me.Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(2, 1).WrapText = 0
End Sub

vẫn ra đúng mà nhỉ

thế thì chắc mình chưa hiểu bản chát rồi, tại mình chỉ check đến cái .responseText nó trả ra ko đúng source code nên mình không làm nữa. Còn nếu cứ lấy data như của bạn là được. Cảm ơn bạn.
Cái mình khó hiểu ở đây là tại sao .responseText trả ra kết quả khác nhỉ? bạn chạy đoạn debug,print .responseText ấy. Nó sẽ trả ra kết quả như thế này:

doccohaiau · 13/9/21

quanluu đã viết:
thế thì chắc mình chưa hiểu bản chát rồi, tại mình chỉ check đến cái .responseText nó trả ra ko đúng source code nên mình không làm nữa. Còn nếu cứ lấy data như của bạn là được. Cảm ơn bạn.
Cái mình khó hiểu ở đây là tại sao .responseText trả ra kết quả khác nhỉ? bạn chạy đoạn debug,print .responseText ấy. Nó sẽ trả ra kết quả như thế này:

thì b chỉ định là debug responseText thì nó chẳng ra cái code html thì ra cái gì b. Cái đó b làm đối tượng để kiểm tra kết quả mà.

quanluu · 13/9/21

doccohaiau đã viết:
thì b chỉ định là debug responseText thì nó chẳng ra cái code html thì ra cái gì b. Cái đó b làm đối tượng để kiểm tra kết quả mà.
View attachment 265978

bạn đang print cái mảng kết quả của bạn rồi. Ý mình là cái này cơ mà:

doccohaiau · 13/9/21

quanluu đã viết:
bạn đang print cái mảng kết quả của bạn rồi. Ý mình là cái này cơ mà:

Cái đó ra dạng code web là đúng rồi mà nhỉ. m ít khi debug. toàn ăn chơi trực tiếp

.
Nhưng m hiểu là nó sẽ lấy toàn bộ CẤU TRÚC WEB hoặc CẤU TRÚC MỘT PHẦN là các phần b yêu cầu ở TRONG ".send" dưới dạng text ( mà text ở đây trên web nó sẽ có dạng code)
(.send "code=mb&end_date=11-9-2021&count=3") ==> sẽ ko load cái giá trị b gán vào.
(Hiểu sai các bác đừng ném gạch ném đá e nhé. Mặc dù e rất muốn có để xây nhà

.)
MUỐN RÕ HƠN b có thể thử debug bằng 1 mảng nào đó xem kết quả nó có vậy ko

quanluu · 13/9/21

doccohaiau đã viết:
Cái đó ra dạng code web là đúng rồi mà nhỉ. m ít khi debug. toàn ăn chơi trực tiếp .
Nhưng m hiểu là nó sẽ lấy toàn bộ CẤU TRÚC WEB hoặc CẤU TRÚC MỘT PHẦN là các phần b yêu cầu ở TRONG ".send" dưới dạng text ( mà text ở đây trên web nó sẽ có dạng code)
(.send "code=mb&end_date=11-9-2021&count=3") ==> sẽ ko load cái giá trị b gán vào.
(Hiểu sai các bác đừng ném gạch ném đá e nhé. Mặc dù e rất muốn có để xây nhà .)

cái này không hợp lý vì nó trả ra hoàn toàn khác chứ ko phải trả ra 1 phần, thứ 2 nữa là thằng htmlDoc của bạn phải lấy từ thằng response này mà.
HTMdoc.body.innerHTML = .responseText

doccohaiau · 13/9/21

quanluu đã viết:
cái này không hợp lý vì nó trả ra hoàn toàn khác chứ ko phải trả ra 1 phần, thứ 2 nữa là thằng htmlDoc của bạn phải lấy từ thằng response này mà.
HTMdoc.body.innerHTML = .responseText

send này nó ko nhận đoạn sau .send kia

đã test. 2 cái ra giống nhau y đúc ==> ktra kỹ thì: Cái này là tải cấu trúc html toàn bộ của web. ko có css.

thứ 2 nữa là thằng htmlDoc của bạn phải lấy từ thằng response này mà.
HTMdoc.body.innerHTML = .responseText thì ở code đã phải chỉ định là duyệt các "tbody" nằm trong các "table" tức nó chỉ là một phần của HTMdoc kia thôi. trong HTMdoc nó còn tr,ul,div,... mà

quanluu · 13/9/21

doccohaiau đã viết:
View attachment 266004
send này nó ko nhận đoạn sau .send kia đã test. 2 cái ra giống nhau y đúc ==> ktra kỹ thì: Cái này là tải cấu trúc html toàn bộ của web. ko có css.

thứ 2 nữa là thằng htmlDoc của bạn phải lấy từ thằng response này mà.
HTMdoc.body.innerHTML = .responseText thì ở code đã phải chỉ định là duyệt các "tbody" nằm trong các "table" tức nó chỉ là một phần của HTMdoc kia thôi. trong HTMdoc nó còn tr,ul,div,... mà

Bạn giải thích không thuyết phục gì cả. Bạn bỏ đoạn code này đi (HTMdoc.body.innerHTML = .responseText) thì đó bạn chạy được ra kết quả đấy.

send này nó ko nhận đoạn sau .send kia đã test. 2 cái ra giống nhau y đúc ==> ktra kỹ thì: Cái này là tải cấu trúc html toàn bộ của web. ko có css.
cái này mình đã kiểm tra ngay từ đầu mình code rồi nhưng không hiểu sao cái response nó trả ra nội dung hoàn toàn khác thôi, cái nào nó cũng lấy html thôi chứ làm gì có cái nào lấy cả đc css. bạn bảo tải cấu trúc html thì nó tải từ link nào? chứ trang chủ của nó cũng không có cấu trúc như thế nhé.

Thôi đợi bạn nào rành về web vậy.

doccohaiau · 13/9/21

quanluu đã viết:
Bạn giải thích không thuyết phục gì cả. Bạn bỏ đoạn code này đi (HTMdoc.body.innerHTML = .responseText) thì đó bạn chạy được ra kết quả đấy.

send này nó ko nhận đoạn sau .send kia đã test. 2 cái ra giống nhau y đúc ==> ktra kỹ thì: Cái này là tải cấu trúc html toàn bộ của web. ko có css.
cái này mình đã kiểm tra ngay từ đầu mình code rồi nhưng không hiểu sao cái response nó trả ra nội dung hoàn toàn khác thôi, cái nào nó cũng lấy html thôi chứ làm gì có cái nào lấy cả đc css. bạn bảo tải cấu trúc html thì nó tải từ link nào? chứ trang chủ của nó cũng không có cấu trúc như thế nhé.

Thôi đợi bạn nào rành về web vậy.

. b muốn thuyết phục như thế thì ==> chốt ở câu cuối của b ý :V.
Nhưng m cũng ko hiểu "khác" của b nó ntn cả. cái gán giá trị nó ko nhận thì đâu có bảng đó

môn này m chẳng am hiểu gì cả

Mã:

Set posts = html.getElementsByClassName("table-kq-hover")(0)
    With MinhNgoc
        For Each post In posts.Rows
            For Each elem In post.Cells
                col = col + 1: Cells(row + 1, col).NumberFormat = "@": Cells(row + 1, col) = elem.innerText
            Next elem
            col = 0
            row = row + 1
        Next post
    End With

lấy nguyên theo form bảng của nó nhìn chắc dễ hơn

quanluu · 13/9/21

doccohaiau đã viết:
. b muốn thuyết phục như thế thì ==> chốt ở câu cuối của b ý :V.
Nhưng m cũng ko hiểu "khác" của b nó ntn cả. cái gán giá trị nó ko nhận thì đâu có bảng đó

môn này m chẳng am hiểu gì cả

Mã:

Set posts = html.getElementsByClassName("table-kq-hover")(0) With MinhNgoc For Each post In posts.Rows For Each elem In post.Cells col = col + 1: Cells(row + 1, col).NumberFormat = "@": Cells(row + 1, col) = elem.innerText Next elem col = 0 row = row + 1 Next post End With

lấy nguyên theo form bảng của nó nhìn chắc dễ hơn

Cái mình cần tìm hiểu là cái responsetext chứ mấy cái code bạn show bên trên thì có có gì đâu, mình lấy đơn giản.

doccohaiau · 13/9/21

quanluu đã viết:
Cái mình cần tìm hiểu là cái responsetext chứ mấy cái code bạn show bên trên thì có có gì đâu, mình lấy đơn giản.

Thế thì b mở topic cho rõ ngọn ngành. chứ topic này ít người quan tâm.
M mấy hôm nay mới động đến cái web get này chứ trước có động bao giờ đâu.
Còn mấy cái code thì ngứa tay là chính. ai cần thì tham khảo thôi

.
Nếu chơi thì mỗi người 1 kiểu chơi. Nếu có dùng đến thì mở web cho nhanh.

Xuân Voi · 19/9/21

phuc1988 đã viết:
mọi người có thể tham khảo giúp mình về file này dc ko.mình ko biết tí gì?nhờ ae chỉ giúp giùm.này là mình bỏ tiền ra mua nhé ae

Bạn có ý tưởng gì cùng nhau thảo luận xem.

trangson061 · 13/10/21

Bị lỗi rồi bạn chỉ giúp

CHAOQUAY · 13/10/21

trangson061 đã viết:
Bị lỗi rồi bạn chỉ giúp

Gửi file lỗi lên bạn

trangson061 · 13/10/21

CHAOQUAY đã viết:
Gửi file lỗi lên bạn

Đây bạn. Giúp tôi với. Tks

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

Thành viên gắn bó

Thành viên chính thức

Thành viên chính thức

Thành viên chính thức

File đính kèm

Thành viên gắn bó

Thành viên chính thức

Thành viên gắn bó

Thành viên chính thức

Thành viên gắn bó

Thành viên chính thức

Thành viên gắn bó

Thành viên chính thức

Thành viên gắn bó

Thành viên chính thức

Thành viên gắn bó

Thành viên chính thức

Thành viên mới

Thành viên mới

File đính kèm

Thành viên gắn bó

Thành viên mới

File đính kèm