GBKEE

¦^´_ 5# lalalada
¸Õ¸Õ¬Ý

1. Option Explicit
   
2. Sub ÃÒ¥æ©Ò_¶R½æ¥æ©ö¤é³øªí()
   
3.     Dim Stock_NO As String, Sh As Worksheet, URL As String, WB As Workbook
   
4.     Do
   
5.       Stock_NO = InputBox("ªÑ²¼¸¹½X")
   
6.       If Stock_NO = "" Then Exit Sub
   
7.     Loop Until Len(Stock_NO) >= 4
   
8.     Set Sh = ActiveWorkbook.Sheets.Add
   
9.     Application.DisplayAlerts = False
   
10.     On Error GoTo Er
    
11.     Sh.Name = Stock_NO
    
12.     Application.StatusBar = "¤U¸ü¸ê®Æ¤¤.... "
    
13.     Application.ScreenUpdating = False
    
14.     URL = "http://bsr.twse.com.tw/bshtm/bsContent.aspx?StartNumber=" & Stock_NO & "&FocusIndex=All_" & ³øªí­¶¼Æ(Stock_NO)
    
15.     Set WB = Workbooks.Open(URL)
    
16.     With WB.Sheets(1)
    
17.         If .UsedRange.Count = 1 Then GoTo xOUT         'ªÑ²¼¨S¦³¸ê®Æ
    
18.         .UsedRange.Columns("A:Q").ClearFormats
    
19.         .UsedRange.Columns("B:H").Delete Shift:=xlToLeft
    
20.         .UsedRange.Columns("B:B").SpecialCells(xlCellTypeBlanks).Offset(, -1).Delete xlShiftUp
    
21.         .UsedRange.Columns("B:E").SpecialCells(xlCellTypeBlanks).Delete xlShiftUp
    
22.         .UsedRange.Columns("F:J").SpecialCells(xlCellTypeBlanks).Delete xlShiftUp
    
23.         .UsedRange.Columns("F:J").Cut .Cells(.Rows.Count, "A").End(xlUp).Offset(1)
    
24.         .Rows("1:2").Delete
    
25.         With .UsedRange
    
26.             .Value = .Value
    
27.             .Sort Key1:=.Range("A2"), Order1:=xlAscending, Header:=xlYes
    
28.             .Offset(3).Replace "§Ç", "=XXX", xlWhole
    
29.             .SpecialCells(xlCellTypeFormulas, xlErrors).EntireRow.Delete
    
30.         End With
    
31.         .UsedRange.Copy Sh.[A1]
    
32.         Sh.UsedRange.EntireColumn.AutoFit
    
33.     End With
    
34.     WB.Close False
    
35.     Application.ScreenUpdating = True
    
36.     Application.StatusBar = False
    
37.     Exit Sub
    
38. Er:
    
39.     Sheets(Stock_NO).Delete
    
40.     Resume
    
41. xOUT:
    
42.     WB.Close False
    
43.     Sheets(Stock_NO).Delete
    
44.     MsgBox "¨S¦³ªÑ²¼ " & Stock_NO
    
45.     Application.StatusBar = False
    
46.     Application.ScreenUpdating = True
    
47. End Sub
    
48. Private Function ³øªí­¶¼Æ(Sstock_N0 As String) As String
    
49.     Dim element As Object
    
50.     With CreateObject("InternetExplorer.Application")
    
51.         .Navigate "http://bsr.twse.com.tw/bshtm/bsMenu.aspx"
    
52.          Do While .Busy Or .ReadyState <> 4
    
53.             DoEvents
    
54.         Loop
    
55.         .Document.getElementsByName("txtTASKNO")(0).Value = Sstock_N0
    
56.         .Document.getElementsByName("btnOK")(0).Click
    
57.          Do While .Busy Or .ReadyState <> 4
    
58.             DoEvents
    
59.         Loop
    
60.        ³øªí­¶¼Æ = .Document.getElementsByName("sp_ListCount")(0).innertext
    
61.        .Quit
    
62.     End With
    
63. End Function

½Æ»s¥N½X

GBKEE

¦^´_ 9# HSIEN6001
¹ï¹Ï§ÎÅçÃÒ¨S¬ã¨s,©Ò¥H¤U¸ü¦C¦LªºÀÉ®×.