|
U模块:
- Sub RefreshData3D(url)
- Dim XmlHttp As Object
- Dim HttpSr As String
- Dim i As Long
- Dim k As Long
- Dim N As Integer
- Dim Arr() As String
- Application.Calculation = xlManual
- Maxr = Cells(Rows.Count, 1).End(3).Row
- Range("a3").Resize(Maxr, 8).ClearContents
- N = Cells(1, 2)
- ReDim Arr(1 To N, 1 To 8)
- Set XmlHttp = CreateObject("Microsoft.XMLHTTP")
- With XmlHttp
- .Open "GET", url
- .setRequestHeader "Content-Type", "text/html"
- .setRequestHeader "If-Modified-Since", Format(Now, "[$-F800]dddd, mmmm dd, yyyy") & " GMT"
- .send ""
- Do Until XmlHttp.ReadyState = 4
- DoEvents
- Loop
- HttpSr = .responsetext
- End With
- hm = Split(HttpSr, Chr(10))
- For i = UBound(hm) - N To UBound(hm) - 1
- qs = Left(hm(i), 7): rq = Mid(hm(i), 9, 10): jh = Mid(hm(i), 20, 5): sj = Mid(hm(i), 26, 5)
- jhh = Split(jh, " ")
- sjj = Split(sj, " ")
- m = m + 1
- Arr(m, 1) = qs
- Arr(m, 2) = rq
- For k = 1 To 3
- Arr(m, k + 2) = jhh(k - 1)
- Arr(m, k + 5) = sjj(k - 1)
- Next
-
- Next
- Cells(3, 1).Resize(N, 8) = Arr
- Set XmlHttp = Nothing
- Maxr = Cells(Rows.Count, 1).End(3).Row + 1
- Range("c1:h1").Merge
- Cells(1, 3) = "By_乐彩心情阳光"
- Range("c1").Interior.ColorIndex = 15
- Range("c1").Font.ColorIndex = 5
- Range("c1").Font.Size = 12
- Cells(Maxr + 1, 1).Select
- Cells(1, "i") = "总期数" & UBound(hm)
- Application.Calculation = xlAutomatic
- MsgBox "更新完成", 64, "提示:"
- End Sub
复制代码
|
|