3楼
都市知心 | 发表于2025-01-23 13:53:30
Private Sub CommandButton1_Click()
Dim i, j, arr
Dim s() As String
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", "http://data.17500.cn/ssq_asc.txt", False
.send
s = Split(VBA.StrConv(.responseBody, vbUnicode, &H804), Chr(10))
End With
List = Array(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 8)
ReDim arr(1 To UBound(s), 1 To 16)
wky = 0
t = 0
ww = 500 '这里表示保留最近500期数据
For i = UBound(s) - ww To UBound(s)
If wky = 0 Or Weekday(Split(s(i), " ")(1), vbMonday) = wky Then
t = t + 1 '用t变量作为提取数据的行数,符合条件则递增1
For j = 1 To 16
arr(t, j) = Split(s(i), " ")(List(j - 1))
Next j
End If
Next i
With Cells(3, 1).Resize(UBound(s), 16)
.ClearContents '当前后提取的数据不是完全一样时,最好先将原区域内容清除
.Value = arr
End With
Range("A199").Select
'Dim jj
'For jj = 1 To ww
'Cells(jj + 3, 2).Value = jj
'Next jj
'下面两行是自动添加下一期开奖期号。
k = [A800].End(xlUp).Row
Cells(k + 1, 1) = Cells(k, 1) + 1
End Sub