|
楼主 |
发表于 2014-5-21 18:47
|
显示全部楼层
- Sub 日期查询1()
- Dim ar
- Dim j As Byte, i As Byte
- Dim r
- Dim k As Integer
- Dim oDoc As Object
- [b4:az65536].ClearContents
- ReDim ar(1 To 79, 1 To 51)
- Set oDoc = CreateObject("htmlfile")
- With CreateObject("Msxml2.XMLHTTP")
- .Open "post", "http://www.hn481.com/Tubiao/Index.aspx", False
- .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
- .send "__VIEWSTATE=%2FwEPDwUJMzcwMDgxNjg1ZGSZszi3MP0rjTOzG%2F4tSpvMa%2FrcBg%3D%3D&__EVENTVALIDATION=%2FwEWCQLAkZ2LAwLdwIe2CAL6%2BO2aAQKH1MzlCAKM54rGBgL0pLPHDAKdxYHOAQL6rKiSDwK7q7GGCCLyKqovVi9S%2Brryg%2FsBvdGJDkXD&txtLoginName=&txtLoginPwd=&txtBeginTime=" & Format([a1], "YYYY-MM-DD") & "&DropDownList1=asc&Button1=&txtStartIssue=&txtEndIssue=&txtCtype=-2&checkbox3=checkbox"
- ' .WaitForResponse
- oDoc.body.innerHTML = .responsetext
- Set r = oDoc.all.tags("table")(0).Rows
- For i = 3 To r.Length - 1
- k = k + 1 '[b65536].End(3).Row
- For j = 0 To r(i).Cells.Length - 1
- ' Cells(k + 1, j + 2) = r(i).Cells(j).innerText
- ar(k, j + 1) = r(i).Cells(j).innerText
- Next j
- Next i
- [b4].Resize(k, 51) = ar
- Set r = Nothing
- End With
- Call incol
- End Sub
- Sub incol()
- Dim arr
- Dim i As Byte, j As Byte
- Dim d As Object
- Set d = CreateObject("scripting.dictionary")
- arr = Range("c4:f81") '奖号
- Range("g4:az81").Interior.ColorIndex = xlNone '号码走势区域颜色为无填充颜色
- For i = 1 To 8
- d(i) = i
- Next i
- For i = 1 To 78
- For j = 1 To 4
- If d.exists(arr(i, j)) Then
- Cells(i + 3, 6 + d(arr(i, j))).Interior.ColorIndex = 10 '合并号码走势区域填充绿色
- Cells(i + 3, j * 8 + 6 + d(arr(i, j))).Interior.ColorIndex = 10 '号码走势区域填充绿色
- End If
- Next j
- Next i
- Set d = Nothing
- End Sub
复制代码
新快赢481.rar
(18.18 KB, 下载次数: 28)
|
|