|
|
再优化一下
- Function XmlToStr(XmlStr)
- Dim Tables, Str
- Dim oHtml As HTMLDocument
- Set oHtml = New HTMLDocument
-
- Dim oXmlHttp As MSXML2.XmlHttp
- Set oXmlHttp = New MSXML2.XmlHttp
-
- With oXmlHttp
- .Open "GET", XmlStr, False
- .send
- XmlToStr = .responseText
- End With
- ''
- ''
- End Function
- Function RegToArr(XmlStr As String, RegStr)
- Dim Arr()
- Dim oRegExp As RegExp
- Dim MatColl As MatchCollection
- Dim oMat As match
- Set oRegExp = New RegExp
- For ii = 0 To 0
- With oRegExp
- .Pattern = RegStr '"(-|)\d℃"
- .Global = True
- .MultiLine = True
- Set MatColl = .Execute(XmlStr)
- End With
- With MatColl
- ReDim Arr(.Count - 1)
- For kk = 0 To .Count - 1
- Set oMat = .Item(kk)
- Arr(kk) = oMat.Value
- Next kk
- End With
- Next ii
- RegToArr = Arr
- End Function
- Function WeatherRegToRng(Rng As Range, XmlStr As String)
-
- Dim WeatDateArr() 'Date
- Dim TempArr() 'Temperature
- Dim WeatArr() 'Weather
- Dim TmpCount, oDate As Date, ArrCount
- TmpCount = 4
- Dim RegArr(2)
- RegArr(0) = "\d{2,4}(-)\d{1,2}(-)\d{1,2}"
- 'RegArr(0) = "\d{2,4}(年)\d{1,2}(月)\d{1,2}(日)"
- RegArr(1) = "(-)?\d+(\.\d\d)?℃"
- RegArr(2) = "多云|晴|阴天|小雨|中雨|霾|阴到小雪|小雪|中雪|大雪"
- ''
-
- WeatDateArr = RegToArr(XmlStr, RegArr(0))
- y = WeatDateArr(4)
- m = Month(y)
- y = Year(y)
- nn = Day(DateSerial(y, m + 1, 0))
-
-
- TempArr = RegToArr(XmlStr, RegArr(1))
- WeatArr = RegToArr(XmlStr, RegArr(2))
-
- For ii = 0 To Day(DateSerial(y, m + 1, 0)) - 1
- Rng(ii, 1) = WeatDateArr(ii)
- Rng(ii, 2) = TempArr(TmpCount)
- Rng(ii, 3) = TempArr(TmpCount + 1)
- Rng(ii, 4) = WeatArr(ii)
- Next ii
- End Function
- ''
- Private Sub ll2()
-
- Dim Rng As Range
- Dim Row As Integer
- Row = 4
- Set Rng = Sheet3.Cells(40, "I")
- Dim XmlStr As String, RegStr As String
-
- XmlStr = Sheet1.Cells(1, 1)
- XmlStr = XmlToStr(XmlStr)
- WeatherRegToRng Rng, XmlStr
-
- End Sub
|
|
楼主: saijintai
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2022-12-3 19:27
