Giúp sửa code lấy dữ liệu web theo ngày (1 người xem)

chaoban888 · 9/3/17

Em có code như sau

Mã:

Sub Macro1()'
' Macro1 Macro
'


'
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://xoso.wap.vn/ket-qua-xo-so-mien-nam-xsmn-ngay-[B][COLOR=#ff0000]01-01-2012[/COLOR][/B].html", _
        Destination:=Range("$A$1"))
        .Name = "ket-qua-xo-so-mien-nam-xsmn-ngay-[COLOR=#ff0000][B]01-01-2012[/B][/COLOR]"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = "2"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
End Sub

Em muốn sửa code tự động lấy dữ liệu từ ngày 01-01-2012 đến hiện tại, dựa vào thay đổi số ngày trên url
và khi lấy dữ liệu mới thi xuống dòng để không đè lên dữ liệu cũ

ndu96081631 · 10/3/17

chaoban888 đã viết:

Em có code như sau

Mã:

Sub Macro1()'
' Macro1 Macro
'


'
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://xoso.wap.vn/ket-qua-xo-so-mien-nam-xsmn-ngay-[B][COLOR=#ff0000]01-01-2012[/COLOR][/B].html", _
        Destination:=Range("$A$1"))
        .Name = "ket-qua-xo-so-mien-nam-xsmn-ngay-[COLOR=#ff0000][B]01-01-2012[/B][/COLOR]"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = "2"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
End Sub

Em muốn sửa code tự động lấy dữ liệu từ ngày 01-01-2012 đến hiện tại, dựa vào thay đổi số ngày trên url
và khi lấy dữ liệu mới thi xuống dòng để không đè lên dữ liệu cũ

Lấy kết quả có 1 ngày mà code chạy còn mất mười mấy giây. Nếu lấy dữ liệu từ năm 2012 đến giờ chắc mở file xong để đó, tháng sau đến xem không biết có kết chưa nữa

chaoban888 · 10/3/17

ndu96081631 đã viết:
Lấy kết quả có 1 ngày mà code chạy còn mất mười mấy giây. Nếu lấy dữ liệu từ năm 2012 đến giờ chắc mở file xong để đó, tháng sau đến xem không biết có kết chưa nữa

Vậy có thể sửa cho em lựa chọn theo ngày bắt đầu và ngày kết thúc theo ý muốn không ạ. Mỗi ngày em load về 1 tháng là được

chaoban888 · 10/3/17

Em đã tạo thêm 1 cột chữa dữ liệu là ngày là 1 tháng

Sau đó dùng code này để chạy

Mã:

Sub Macro1()
For i = 1 To 31
Set ngay = Sheets("Sheet1").Cells(i, 1)


    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://xoso.wap.vn/ket-qua-xo-so-mien-nam-xsmn-ngay-" & ngay & ".html", _
        Destination:=Range("$B$1"))
        .Name = "ket-qua-xo-so-mien-nam-xsmn-ngay-" & ngay
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = "2"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
    Next i
End Sub

Có anh chị nào có cách nào hay hơn không ạ ?

ndu96081631 · 10/3/17

chaoban888 đã viết:
Vậy có thể sửa cho em lựa chọn theo ngày bắt đầu và ngày kết thúc theo ý muốn không ạ. Mỗi ngày em load về 1 tháng là được

Vầy được không:

Mã:

Private Const sURL = "URL;http://xoso.wap.vn/ket-qua-xo-so-mien-nam-xsmn-ngay-"
Private Sub GetLoto(ByVal StartDate As Date, EndDate As Date)
  Dim nD As Long, sDate As String, Target As Range
  Columns("A:D").ClearContents
  For nD = StartDate To EndDate
    Set Target = Range("A60000").End(xlUp).Offset(2)
    sDate = Format(nD, "dd-mm-yyyy")
    With ActiveSheet.QueryTables.Add(sURL & sDate & ".html", Range("A60000").End(xlUp).Offset(2))
      .Name = "ket-qua-xo-so-mien-nam-xsmn-ngay-" & sDate
      .FieldNames = True
      .RowNumbers = False
      .FillAdjacentFormulas = False
      .PreserveFormatting = True
      .RefreshOnFileOpen = False
      .BackgroundQuery = True
      .RefreshStyle = xlInsertDeleteCells
      .SavePassword = False
      .SaveData = True
      .AdjustColumnWidth = True
      .RefreshPeriod = 0
      .WebSelectionType = xlSpecifiedTables
      .WebFormatting = xlWebFormattingNone
      .WebTables = "2"
      .WebPreFormattedTextToColumns = True
      .WebConsecutiveDelimitersAsOne = True
      .WebSingleBlockTextImport = False
      .WebDisableDateRecognition = False
      .WebDisableRedirections = False
      .Refresh BackgroundQuery:=False
    End With
    With Target
      .NumberFormat = "dd/mm/yyyy"
      .Value = nD
      .Resize(, 4).EntireColumn.AutoFit
     End With
  Next
End Sub
[COLOR=#ff0000]Sub Main()
  Dim StartDate As Date, EndDate As Date
  StartDate = Range("J2").Value  ''Từ ngày
  EndDate = Range("K2").Value   ''Đến ngày
  GetLoto StartDate, EndDate
End Sub[/COLOR]

Toàn bộ code trên bạn chì cần quan tâm chỗ màu đỏ
StartDate là ngày bắt đầu, EndDate là ngày kết thúc. Như Sub Main ở trên tôi đặt 2 cell J2 và K2 là ngày bắt đầu và kết thúc. Vậy chỉ cần gõ ngày vào 2 cells này rồi chạy code là được rồi. Không thích gõ vào cell thì gán luôn ngày tháng vào code cũng được
------------------------
Nói thêm: Tôi để y chang code của bạn, chỉ sửa một chút để bạn có thể tùy biến ngày tháng

chaoban888 · 10/3/17

Cảm ơn bác, bác giải chuẩn quá -=.,,

chaoban888 · 11/3/17

ndu96081631 đã viết:
Toàn bộ code trên bạn chì cần quan tâm chỗ màu đỏ
StartDate là ngày bắt đầu, EndDate là ngày kết thúc. Như Sub Main ở trên tôi đặt 2 cell J2 và K2 là ngày bắt đầu và kết thúc. Vậy chỉ cần gõ ngày vào 2 cells này rồi chạy code là được rồi. Không thích gõ vào cell thì gán luôn ngày tháng vào code cũng được
------------------------
Nói thêm: Tôi để y chang code của bạn, chỉ sửa một chút để bạn có thể tùy biến ngày tháng

Khi em sử dụng phát hiện ra một vấn đề là các số có số 0 ở đầu nó tự mất đi, ví dụ 00 -> 0, 0123 -> 123, 005 -> 5 như vậy là không đúng
Vậy phải sửa như nào ạ ?

chaoban888 · 12/3/17

Để sửa lỗi ở trên em đã dùng code này

Mã:

Sub ccc()
Dim i As Integer


i = 4
Do Until i > 7321
For j = 2 To 5
    Sheets("2012").Cells(i, j).NumberFormat = "00"
    Next j
    i = i + 20
Loop


i = 5
Do Until i > 7321
For j = 2 To 5
    Sheets("2012").Cells(i, j).NumberFormat = "000"
    Next j
    i = i + 20
Loop


i = 6
Do Until i > 7321
For j = 2 To 5
    Sheets("2012").Cells(i, j).NumberFormat = "0000"
    Next j
    i = i + 20
Loop


i = 7
Do Until i > 7321
For j = 2 To 5
    Sheets("2012").Cells(i, j).NumberFormat = "0000"
    Next j
    i = i + 20
Loop


i = 8
Do Until i > 7321
For j = 2 To 5
    Sheets("2012").Cells(i, j).NumberFormat = "0000"
    Next j
    i = i + 20
Loop


i = 9
Do Until i > 7321
For j = 2 To 5
    Sheets("2012").Cells(i, j).NumberFormat = "0000"
    Next j
    i = i + 20
Loop


i = 10
Do Until i > 7321
For j = 2 To 5
    Sheets("2012").Cells(i, j).NumberFormat = "00000"
    Next j
    i = i + 20
Loop


i = 11
Do Until i > 7321
For j = 2 To 5
    Sheets("2012").Cells(i, j).NumberFormat = "00000"
    Next j
    i = i + 20
Loop


i = 12
Do Until i > 7321
For j = 2 To 5
    Sheets("2012").Cells(i, j).NumberFormat = "00000"
    Next j
    i = i + 20
Loop


i = 13
Do Until i > 7321
For j = 2 To 5
    Sheets("2012").Cells(i, j).NumberFormat = "00000"
    Next j
    i = i + 20
Loop


i = 14
Do Until i > 7321
For j = 2 To 5
    Sheets("2012").Cells(i, j).NumberFormat = "00000"
    Next j
    i = i + 20
Loop


i = 15
Do Until i > 7321
For j = 2 To 5
    Sheets("2012").Cells(i, j).NumberFormat = "00000"
    Next j
    i = i + 20
Loop


i = 16
Do Until i > 7321
For j = 2 To 5
    Sheets("2012").Cells(i, j).NumberFormat = "00000"
    Next j
    i = i + 20
Loop


i = 17
Do Until i > 7321
For j = 2 To 5
    Sheets("2012").Cells(i, j).NumberFormat = "00000"
    Next j
    i = i + 20
Loop


i = 18
Do Until i > 7321
For j = 2 To 5
    Sheets("2012").Cells(i, j).NumberFormat = "00000"
    Next j
    i = i + 20
Loop


i = 19
Do Until i > 7321
For j = 2 To 5
    Sheets("2012").Cells(i, j).NumberFormat = "00000"
    Next j
    i = i + 20
Loop


i = 20
Do Until i > 7321
For j = 2 To 5
    Sheets("2012").Cells(i, j).NumberFormat = "00000"
    Next j
    i = i + 20
Loop


i = 21
Do Until i > 7321
For j = 2 To 5
    Sheets("2012").Cells(i, j).NumberFormat = "000000"
    Next j
    i = i + 20
Loop


End Sub

Anh chị cho em cách khác chứ sao em thấy dài quá

Giúp sửa code lấy dữ liệu web theo ngày (1 người xem)

Người dùng đang xem chủ đề này

chaoban888

Thành viên mới

ndu96081631

Huyền thoại GPE

chaoban888

Thành viên mới

chaoban888

Thành viên mới

File đính kèm

ndu96081631

Huyền thoại GPE

File đính kèm

chaoban888

Thành viên mới

chaoban888

Thành viên mới

chaoban888

Thành viên mới

File đính kèm

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

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

Đếm ngược thời gian