|
|
本帖最后由 838833928 于 2024-5-29 23:19 编辑
要求比下面代码更快捷的方式，生意难做【求老师帮忙】
#If Win64 Then
Private Declare PtrSafe Sub sleepp Lib "kernel32.dll" Alias "Sleep" (ByVal dwMilliseconds As LongLong)
Private Declare PtrSafe Function DeleteUrlCacheEntry Lib "wininet" Alias "DeleteUrlCacheEntryA" (ByVal lpszUrlName As String) As LongLong
#Else
Private Declare Sub sleepp Lib "kernel32.dll" Alias "Sleep" (ByVal dwMilliseconds As Long)
Private Declare Function DeleteUrlCacheEntry Lib "wininet" Alias "DeleteUrlCacheEntryA" (ByVal lpszUrlName As String) As Long
#End If
'-☆-------------------------------------------------------------------------------------------------
Sub BtcData()
AutoRedraw = False
Dim i As Long, x As Long
Dim dat()
Row = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row + 1
'-·-·-·-·-·-·-·-·-·-·-·-·-·-·-·-·-·-·-·-·-·-·-·-·-·-·-·-·-·-·-·-·-·-·-
Dim objXML As Object ' ▓数据代码▓ -☆-
On Error Resume Next
Dim tmp() As String, P As Long, arr() As String, xmlhttp As Object, T As Single, COOKIE As String, q%, H%, Lottery
Csq = 100
q = Csq
Set xmlhttp = CreateObject("WinHttp.WinHttpRequest.5.1")
Lottery = "https://www.h-h-gaming.com/index.php/Home/Index/dataAnalysis/label/leli_fenfen/type/4.html#"
'https://www.h-h-gaming.com/index.php/Home/Index/dataAnalysis/label/xinli_ssc/type/4.html#
With xmlhttp
.Option(6) = 0
.Open "GET", Lottery, False
.setRequestHeader "Connection", "Keep-Alive"
.send
COOKIE = Split(.getResponseHeader("Set-Cookie"), ";")(0)
End With
With xmlhttp
.Open "GET", Lottery, False
.Option(6) = 1
.send
.setRequestHeader "Cookie", COOKIE
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.setRequestHeader "Connection", "Keep-Alive"
.send "method=queryOffices&isStock=&pageNum=" & P & "&ascGuid=00000000000000000000000000000000&offName=&offCode=&cpaNum=1"
txtContent = .responseText
S1 = txtContent
S2 = Split(S1, "parseJSON('[{")(1)
S3 = Split(S2, "}]');")(0)
S4 = Split(S3, "},{")
If UBound(S4) >= q - 1 Then H = q - 1 Else H = UBound(S4)
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'--------------------------------------------------------------------------------------------------
ReDim dat(0 To q, 1 To 19)
For i = 0 To H
x = H - i
With Sheet1
'-·-·-·-·-·-·-·-·-·-·-·-·-·-·-·-·-·-·-·-·-·-·-·-·-·-·-·-·-·-·-·-·-·-·-
Dim 时, 分 '-☆- ▓开奖时间▓ -☆-
分 = (Right(Split(S4(i), """")(3), 4)) Mod 60
If 分 <> 0 Then 分 = 分 - 1 Else: 分 = 59
时 = ((Right(Split(S4(i), """")(3), 4)) - (Right(Split(S4(i), """")(3), 4)) Mod 60) / 60
If Right(Split(S4(i), """")(3), 4) <= "0240" Then
If Right(Split(S4(i), """")(3), 4) Mod 60 = 0 Then 时 = 时 - 1
Else
If Right(Split(S4(i), """")(3), 4) Mod 60 = 0 Then 时 = 时 + 1 Else: 时 = 时 + 2
End If
'.Cells(i + 101, 1).NumberFormat = "yyyy/mm/dd hh:mm"
dat(x, 3) = Left(Split(S4(i), """")(3), 4) & "/" & _
Format(Mid(Split(S4(i), """")(3), 5, 2), "00") & "/" & _
Format(Mid(Split(S4(i), """")(3), 7, 2), "00") & " " & _
Format(时 & ":" & 分 & ":" & "17", "hh:mm:ss")
'--------------------------------------------------------------------------------------------------
'-※- ▓开奖期号▓ -※-
dat(x, 1) = Format(Replace(Split(S4(i), """")(3), "-", ""), "000000000000")
'-※- ▓开奖号码▓ -※-"'" &
dat(x, 2) = Format(Replace(Split(S4(i), """")(7), ",", ""), "00000")
'-※- ▓开奖时间▓ -※-
dat(x, 3) = Split(S3(i), Chr(34))(29)
End With
Next i
Set objXML = Nothing
End With
''--------------------------------------------------------------------------------------------------
''将得到的数据写入表格
''-※-
With Sheet1
.Cells(101, 1).Resize(UBound(dat), 3) = dat
End With
'-·-·-·-·-·-·-·-·-·-·-·-·-·-·-·-·-·-·-·-·-·-·-·-·-·-·-·-·-·-·-·-·-·-·-
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
|
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2024-5-29 16:15
楼主
