- ©«¤l
- 5923
- ¥DÃD
- 13
- ºëµØ
- 1
- ¿n¤À
- 5986
- ÂI¦W
- 0
- §@·~¨t²Î
- win10
- ³nÅ骩¥»
- Office 2010
- ¾\ŪÅv
- 150
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥xÆW°ò¶©
- µù¥U®É¶¡
- 2010-5-1
- ³Ì«áµn¿ý
- 2022-1-23
|
¥»©«³Ì«á¥Ñ GBKEE ©ó 2016-3-4 14:19 ½s¿è
¦^´_ 9# yehmengfeng
¸Õ¸Õ¬Ý
UserForm ¼Ò²Õªºµ{¦¡½X
UserForm »Ý¨î©w±±¨î¶µ CommandButton1,ComboBox1,ComboBox2- Option Explicit
- Dim Sh(1 To 2) As Worksheet
- Private Sub UserForm_Initialize()
- Set Sh(1) = Sheets.Add '³]©w·s¼W¤u§@ªí
- Sh(1).Visible = False 'ÁôÂäu§@ªí
- Æ[´ú¬d¸ß_³]©w
- End Sub
- Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
- Application.DisplayAlerts = False
- Sh(1).Delete
- Application.DisplayAlerts = True
- End Sub
- Private Sub Æ[´ú¬d¸ß_³]©w()
- Dim Url As String, i As Double, op As Object, xDate As Date
- Dim oHtmldoc As Object
- Set oHtmldoc = CreateObject("htmlfile")
- Url = "http://e-service.cwb.gov.tw/HistoryDataQuery/QueryDataController.do?command=viewMain" '
- With CreateObject("msxml2.xmlhttp")
- .Open "Get", Url, False
- .Send
- oHtmldoc.write .responseText
- End With
- With ComboBox1
- For Each op In oHtmldoc.all.tags("SELECT")(0)
- .AddItem
- .List(.ListCount - 1, 0) = op.innertext '´ú¯¸:¦WºÙ
- .List(.ListCount - 1, 1) = op.Value '´ú¯¸:¼ÆÈ
- Next
- .ListIndex = 0
- End With
- With ComboBox2
- For i = 0 To -59 Step -1 '60Ó¤ë¥÷
- xDate = DateAdd("M", i, Date)
- .AddItem
- .List(.ListCount - 1, 0) = Format(xDate, "EE¦~MM¤ë")
- .List(.ListCount - 1, 1) = DateSerial(Year(xDate), Month(xDate), 1)
- Next
- .ListIndex = 0
- End With
- End Sub
- Private Sub CommandButton1_Click() '«ö¯Ã(¸ê®Æ¬d¸ß)
- Dim surl As String, QT As Range, Qdate As Date, Station As String, Msg As Boolean
- 'http://e-service.cwb.gov.tw/HistoryDataQuery/DayDataController.do?
- surl = "URL;http://e-service.cwb.gov.tw/HistoryDataQuery/DayDataController.do?"
- surl = surl & "command=viewMain&station=" & ComboBox1.List(ComboBox1.ListIndex, 1)
- Station = ComboBox1.List(ComboBox1.ListIndex, 0) & "(" & ComboBox1.List(ComboBox1.ListIndex, 1) & ")" '¤u§@ªí¦WºÙ
- On Error GoTo Make_station: '³B¸Ì¿ù»~: ´ú¯¸¤£¦s¦b
- Set Sh(2) = Sheets(Station) '«ü©w¤u§@ªí(´ú¯¸)
- On Error GoTo 0 '¦³¿ù»~¤£³B²z¤F
- Application.ScreenUpdating = False
- For Qdate = ComboBox2.List(ComboBox2.ListIndex, 1) To DateAdd("m", 1, ComboBox2.List(ComboBox2.ListIndex, 1)) - 1
- surl = "URL;http://e-service.cwb.gov.tw/HistoryDataQuery/DayDataController.do?command=viewMain&station=" & ComboBox1.List(ComboBox1.ListIndex, 1) & "&datepicker=" & Format(Qdate, "yyyy-m-dd")
- If Qdate > Date Then Exit For '¤é´Á¤j©ó·í¤é
- If Not Sh(2).Range("A:A").Find(Qdate, LookIn:=xlFormulas) Is Nothing Then GoTo Ne '¤é´Á¸ê®Æ¤w¦s¦b,¤U¤@¤é´Á°j°é
- Application.StatusBar = "¶×¤J " & Qdate & " ¸ê®Æ..." 'ª¬ºA¦Cªº¤å¦r
- With Sh(1)
- .UsedRange.Delete
- With .QueryTables.Add(Connection:=surl, Destination:=.Range("$A$1"))
- .WebTables = "MyTable"
- .WebFormatting = xlWebFormattingNone
- .Refresh BackgroundQuery:=False
- If .ResultRange.Rows.Count > 5 Then '¦³¸ê®Æ
- Set QT = .ResultRange '§tªíÀYªº¸ê®Æ½d³ò
- With Sh(2)
- If .UsedRange.Count = 1 Then '¤u§@ªí(´ú¯¸)¬°ªÅ¥Õ
- .Range("A1") = "Æ[´ú®É¶¡"
- .Range("A1").Resize(5).Merge
- Else
- Set QT = QT.Rows("6:" & QT.Rows.Count) '¤£§tªíÀYªº¸ê®Æ
- End If
- With .Cells(Rows.Count, "b").End(xlUp)
- If .Row = 1 Then '¤u§@ªí(´ú¯¸)¬°ªÅ¥Õ
- QT.Copy .Cells
- Else '.Row = 4 ->¨S¦³¸ê®Æ¦ý¦³ªíÀY
- QT.Copy .Cells(IIf(.Row = 4, 3, 2))
- End If
- End With
- With .Range(.Cells(Rows.Count, "A").End(xlUp).Offset(1).Address & ":A" & Sh(2).Cells(Rows.Count, "B").End(xlUp).Row)
- .Cells = Qdate 'AÄæ¼g¤W¤é´Á
- .NumberFormatLocal = "yyyy-mm-dd" 'µ¹¤©®æ¦¡
- End With
- End With
- End If
- .Delete
- End With
- End With
- Ne:
- Next
- Application.StatusBar = False
- Application.ScreenUpdating = True
- '±Æ§Ç
- With Sh(2).UsedRange.Offset(5)
- .Sort Key1:=.Range("A1"), Order1:=xlAscending, Key2:=.Range("B1"), Order2:=xlAscending, Header:=xlNo
- End With
- Exit Sub
- Make_station:
- Sheets.Add(Sheet1).Name = Station '·s¼W¤u§@ªí(´ú¯¸)
- Resume '¦^¨ì¿ù»~ªºµ{¦¡½XÄ~Äòµ{¦¡
- End Sub
½Æ»s¥N½X |
|