|
本帖最后由 hwc2ycy 于 2013-5-22 15:22 编辑
你用这个,配合记事本。
split函数你看看帮助,也好理解的。- Sub 查询天气()
- Dim strDate$
- Dim strUrl$
- Dim strText$
- Dim strFind$
- Dim arr1, arr2, result(1 To 32, 1 To 6)
- Dim i As Long, j As Byte, k As Byte, m As Byte
- Dim httpRequest As Object
- Dim myClip As Object
- strUrl = "http://lishi.tianqi.com/jiangjin/"
- strDate = Application.InputBox("请输入要查询的年月格式为yyyymm", , Format(Now - Day(Now) - 1, "yyyymm"), , , , , 2)
- If Len(strDate) <> 6 Or Not strDate Like "20*" Then
- MsgBox "查询月份不对"
- Exit Sub
- End If
- '剪贴板对象
- Set myClip = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
- Set httpRequest = CreateObject("Msxml2.XMLHTTP.3.0")
- With httpRequest
- .Open "GET", strUrl & strDate & ".html", False
- .send
- strText = .responseText
- End With
- With myClip
- strFind = "江津" & Left(strDate, 4) & "年" & Val(Right(strDate, 2)) & "月份天气详情"
- i = InStr(strText, strFind)
- 'If UBound(Split(strText, strFind)) = 0 Then
- If i = 0 Then
- MsgBox "查询月份不对"
- Exit Sub
- End If
- '网页原始数据放入剪贴板中
- .SetText strText '变量
- .PutInClipboard
- MsgBox "1.打开记事本,粘贴" & vbCrLf & "这是原始数据" & _
- vbCrLf & vbCrLf & "在记事本数据里查找 " & vbCrLf & _
- strFind & vbCrLf
- strText = Split(strText, strFind)(1)
- '网页原始数据放入剪贴板中
- .SetText strText '变量
- .PutInClipboard
- MsgBox "2.继续在记事本里粘贴" & vbCrLf & "现在的数据是提取了位于 " & strFind & " 后的所有数据" & _
- vbCrLf & vbCrLf & "在记事本数据里查找 </div> ,注意第1,2个</div>之间的数据"
-
- strText = Split(strText, "</div>")(1)
- '网页原始数据放入剪贴板中
- .SetText strText '变量
- .PutInClipboard
- MsgBox "3.继续在记事本里粘贴" & vbCrLf & "现在的数据是提取第1,2个</div>之间的数据" & _
- vbCrLf & vbCrLf & "在记事本数据里查找 " & "<ul class=""t1"">"
-
-
- strText = Replace(strText, "<ul class=""t1"">", "<ul>")
-
- '网页原始数据放入剪贴板中
- .SetText strText '变量
- .PutInClipboard
- MsgBox "4.继续在记事本里粘贴" & vbCrLf & "现在 " & "<ul class=""t1""> 已经替换成了 <ul>" & _
- vbCrLf & "好了,前期数据已经处理完了,剩下的就是利用split函数进行数据的提取了" & _
- vbCrLf & "如果split懂的话,可以把注释的用LEFT函数的语句打开,F8单步,应该就会明白了。"
-
-
- 'Mid(strText, i)
- 'i = InStr(Len(strFind) + 20, strText, "</div>")
- 'strText = Left(strText, i - 1)
- 'strText = Replace(strText, "<ul class=""t1"">", "<ul>")
- End With
-
- arr1 = Split(strText, "<ul>")
- arr2 = Split(arr1(1), "<li>")
- m = m + 1
- '标题
- For k = LBound(arr2) + 1 To UBound(arr2)
- result(m, k) = Split(arr2(k), "<")(0)
- 'result(m, k) = Left(arr2(k), InStr(arr2(k), "<") - 1)
- Next
- For j = LBound(arr1) + 2 To UBound(arr1)
- arr2 = Split(arr1(j), "<li>")
- m = m + 1
-
- '第1列日期
- result(m, 1) = Split(Split(arr2(1), ">")(1), "<")(0)
- 'result(m, 1) = Mid(arr2(1), InStr(arr2(1), ">") + 1, 10)
-
- '第2列到6列
- For k = LBound(arr2) + 2 To UBound(arr2)
- result(m, k) = Split(arr2(k), "<")(0)
- 'result=Left(arr2(k), InStr(arr2(k), "<") - 1)
- Next
- Next
- Application.ScreenUpdating = False
- With Range("a2")
- .CurrentRegion.ClearContents
- .Resize(m, UBound(result, 2)).Value = result
- .CurrentRegion.EntireColumn.AutoFit
- End With
-
- Range("a1").Value = strFind
-
- Application.ScreenUpdating = True
-
- MsgBox "提取完成"
- End SuB
复制代码 |
|