- ©«¤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
|
¦^´_ 6# mannyhsu - Option Explicit
- Sub Ӫѥæ©ö©ú²Ó¤U¸ü()
- Dim ªÑ²¼¥N¸¹ As String, ¤é´Á As Variant, N As Name, i As Integer, T As Date, A
- Do While Not IsDate(¤é´Á)
- ¤é´Á = InputBox("¿é¤J¬d¸ß¤é´Á", "¤é´Á", Date)
- If ¤é´Á = "" Then End
- Loop
- Do While ªÑ²¼¥N¸¹ = ""
- ªÑ²¼¥N¸¹ = InputBox("ªÑ²¼¥N¸¹", "¿é¤J¬d¸ß¤§ªÑ²¼¥N¸¹", "1101")
- If ¤é´Á = "" Then End
- Loop
- ¤é´Á = Format(¤é´Á, "yyyymmdd")
- T = Time
- With ActiveSheet
- .Cells.Clear
- DoEvents
- Application.ScreenUpdating = False
- Application.StatusBar = False
- With .QueryTables.Add(Connection:="URL;http://bsr.twse.com.tw/bshtm/bsContent.aspx?strDate=" & ¤é´Á & "&StartNumber=" & ªÑ²¼¥N¸¹ & "&FocusIndex=1", Destination:=Range("A1"))
- .BackgroundQuery = True
- .WebTables = "6,7"
- .Refresh BackgroundQuery:=False
- .ResultRange(1).End(xlDown).Offset(2).CurrentRegion.Cut .ResultRange(1).End(xlToRight).Offset(, 1)
- If Application.CountA(.ResultRange) = 0 Then
- MsgBox Format(¤é´Á, "0000/00/00") & " ¥ð¥«!!! ©Î ªÑ²¼¥N¸¹:" & ªÑ²¼¥N¸¹ & " ¿ù»~ !!!"
- [A1].Select
- End
- End If
- ActiveSheet.Names(.Name).Delete
- End With
- i = 2
- Do
- .Cells(.Rows.Count, 1).End(xlUp).Offset(1).Select
- With .QueryTables.Add(Connection:="URL;http://bsr.twse.com.tw/bshtm/bsContent.aspx?strDate=" & ¤é´Á & "&StartNumber=" & ªÑ²¼¥N¸¹ & "&FocusIndex=" & i, Destination:=Selection)
- .BackgroundQuery = True
- .WebTables = "6,7"
- On Error Resume Next
- Do
- Err.Clear
- .Refresh BackgroundQuery:=False
- Loop Until Err.Number = 0
- On Error GoTo 0
- If Application.CountA(.ResultRange) = 0 Then GoTo OUT
- .ResultRange(1).End(xlDown).Offset(2).CurrentRegion.Cut .ResultRange(1).End(xlToRight).Offset(, 1)
- .ResultRange(1).EntireRow.Delete
- ActiveSheet.Names(.Name).Delete
- i = i + 1
- End With
- Loop
- OUT:
- .[A1].Select
- Application.ScreenUpdating = True
- With .UsedRange
- .WrapText = False
- .Interior.ColorIndex = xlNone
- .Font.Size = 12
- .Columns.AutoFit
- A = CreateObject("WScript.Shell").popup("¦@¤U¸ü " & i & " ¶¶O®É " & Format(Time - T, "hh:mm¤ÀSS¬í"), 5, ¤é´Á & "_" & ªÑ²¼¥N¸¹, 48 + 0)
- Application.StatusBar = ¤é´Á & " _ " & ªÑ²¼¥N¸¹ & " ¦@¤U¸ü " & i & "¶ ¶O®É " & Format(Time - T, "HH:MM:SS")
- End With
- For Each N In .Names
- N.Delete
- Next
- End With
- End Sub
½Æ»s¥N½X |
|