楼主
xmyjk |
Q:从
A:第一种方法QUERYTABLE:
- Sub 宏1()
- Dim Y&, M&, D&, arr, n, nm
-
- ActiveSheet.UsedRange.Clear
- arr = Array("Beijing", "Shanghai")
-
- For n = LBound(arr) To UBound(arr)
-
- For i = 0 To 2
- Y = 1 '调整变量Y(对应年),M(对应月),D(对应日)的不同值,即可得到不同日期的结果
- M = 0 '本例为1年后(即2012-6-4日的天气情况)
- D = i
-
- With ActiveSheet.QueryTables.Add(Connection:= _
- "URL;http://www.t7online.com/t7text/" & arr(n) & "/wtable" & Format(DateSerial(Year(Date) + Y, Month(Date) + M, Day(Date) + D), "yyyymmdd") & ".htm", Destination:=Cells(n * 50 + 1, i * 10 + 1))
- .BackgroundQuery = True
- .RefreshStyle = xlOverwriteCells
- .AdjustColumnWidth = True
- .WebSelectionType = xlSpecifiedTables
- .WebFormatting = xlWebFormattingNone
- .WebTables = "6"
- .Refresh BackgroundQuery:=False
- End With
-
- Cells(n * 50 + 1, i * 10 + 1).QueryTable.Delete
-
- Next
-
- Next
-
- End Sub
第二种方法：XMLHTTP:
- Option Explicit
- Sub test()
- Dim tmp() As String, i As Integer, arr() As String, xmlhttp As Object, N As Long, tmp1() As String, riqi As String
- Dim Y As Integer, M As Integer, D As Integer, CITY, P As Integer, X As Integer
-
- ActiveSheet.UsedRange.Clear
- CITY = Array("Beijing", "Shanghai")
-
- For P = LBound(CITY) To UBound(CITY)
- For X = 0 To 2
- Y = 1: M = 0: D = X
-
- Cells(P * 50 + 1, X * 10 + 1).Offset(1).Resize(1, 10) = Split("地市州,夜间,白天,最高气温,最高气温趋势,最低气温,白天风向,白天风速,21日降水量,紫外线指数", ",")
-
- Set xmlhttp = CreateObject("Microsoft.XMLHTTP")
- With xmlhttp
- .Open "get", "http://www.t7online.com/t7text/" & CITY(P) & "/wtable" & Format(DateSerial(Year(Date) + Y, Month(Date) + M, Day(Date) + D), "yyyymmdd") & ".htm", False
- .send
- tmp = Filter(Split(Replace(Replace(Replace(Replace(Replace(Replace(.responsetext, """middle""><", """middle""> <"), ";""><", ";""> <"), """20""><", """20"""), """><", "<"), """ TITLE=""", ">"), "</a>", ""), "</td>"), "<td height=""20""")
- riqi = Trim(Split(Split(Replace(.responsetext, vbLf, ""), "<td align=""center"" style=""font-weight: bold;"">")(1), "&")(0))
- End With
-
- ReDim arr(UBound(tmp) \ 10, 9)
- For i = 0 To UBound(tmp)
- tmp1() = Split(tmp(i), ">")
- arr(i \ 10, i Mod 10) = Trim(tmp1(UBound(tmp1)))
- Next
-
- Cells(P * 50 + 1, X * 10 + 1) = riqi
- Cells(P * 50 + 1, X * 10 + 1).Offset(2).Resize(UBound(arr) + 1, UBound(arr, 2) + 1) = arr
-
- Erase tmp, tmp1
- Erase arr
- Set xmlhttp = Nothing
- Next
- Next
- [a:AD].Columns.AutoFit
- MsgBox "Ok"
- End Sub
 天气预报XMLHTTP版本.rar
天气预报查询querytable.rar
|
3楼
huangzhihua |
下載謝謝学习,,,,,,,,,,,,,,,,,,,, |
