GBKEE

¦^´_ 1# sasho

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim i As Integer, rng As Range
   
4.     With ActiveSheet
   
5.         If .QueryTables.Count = 0 Then .QueryTables.Add "URL;", .[a1]
   
6.         For i = 3 To 17 Step 2
   
7.             '°j°é¤¤£¸ª½ªº querytable.add ÀÉ®×·|­D°_¨Ó,¾É­Pµ{¦¡ªº³t«×¶V¨Ó¶VºC
   
8.             With .QueryTables(1)
   
9.                 .Connection = "URL;http://forum.twbts.com/thread-635-1-1.html"
   
10.                 .WebSelectionType = xlSpecifiedTables
    
11.                 .WebFormatting = xlWebFormattingNone
    
12.                 .WebTables = i & ""
    
13.                 .WebPreFormattedTextToColumns = True
    
14.                 .WebConsecutiveDelimitersAsOne = True
    
15.                 .WebSingleBlockTextImport = False
    
16.                 .WebDisableDateRecognition = False
    
17.                 .WebDisableRedirections = False
    
18.                 .Refresh BackgroundQuery:=False
    
19.                 Wb_Save .ResultRange, i
    
20.             End With
    
21.         Next
    
22.    End With
    
23. End Sub
    
24. Private Sub Wb_Save(Rng As Range, i As Integer)  '°Æµ{¦¡:·s¼W¬¡­¶Ã¯,¦sÀÉ
    
25.     With Workbooks.Add(1)
    
26.         Rng.Copy .Sheets(1).[a1]
    
27.         .Close True, "d:\test_" & i & ".xls"
    
28.         'Ãö³¬¦sÀÉ
    
29.     End With
    
30. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 9# sasho

°Ñ¦Ò ³o¸Ì

GBKEE

¦^´_ 11# sasho
§A¨Ï¥Îªº¬OEXCEL 2010 ,¥i§_¤W¶Ç§AªºÀÉ®×.
§Ú¨Ó¸Õ¸Õ  XP¡B32¦ì¤¸¡B1G°O¾ÐÅé ,2003ª©¥»ªº³t«×

GBKEE

¦^´_ 13# sasho
§A­ì¥»ªº Sub °õ¦æ(),¦b§ÚªºPC¨S¦³§A©Ò»¡ªº¶V¨Ó¶VºCªº±¡§Î.³t«×»PMain() ªº°O¿ýÀÉ®t¤£¦h.

¾ã²z¤@¤U,ªþ¤W Sub Main() ªº°O¿ýÀÉ

Ex.rar (10.87 KB)

¤U¸ü¦¸¼Æ: 13

2014-6-25 13:18

1. Option Explicit
   
2. Dim IE As Object, Query_Sh As Worksheet, CsvPath As String, SaveDate As String
   
3. Dim t As Date, StartTime As Date, °O¿ýÀÉ As String, stockid As Range, spListCount As Integer
   
4. Sub Main()
   
5.     Dim i As Integer
   
6.     t = Time
   
7.     StartTime = Time
   
8.     CsvPath = "D:\TSE\"
   
9.     ¥Ø¿ý CsvPath
   
10.     °O¿ýÀÉ = CsvPath & "Main_Record.TXT"
    
11.     If Dir(°O¿ýÀÉ) <> "" Then Kill °O¿ýÀÉ
    
12.     ¼È¦s­¶ "temp"
    
13.     xRecond 0, "µ{¦¡¶}©l°õ¦æ" & vbCrLf
    
14.     Set stockid = Sheets("¤u§@ªí1").Range("A2")
    
15.     stockid.Parent.Activate
    
16.     Do While stockid <> ""
    
17.         Application.ScreenUpdating = True
    
18.         stockid.Select
    
19.         Application.ScreenUpdating = False
    
20.         StartTime = Time
    
21.         spListCount = ¸ê®Æ­¶¼Æ
    
22.         If spListCount > 0 Then
    
23.             i = i + 1
    
24.             xRecond i, stockid & vbTab & "¸ê®Æ¶×¤J"
    
25.             ¸ê®Æ¶×¤J
    
26.             ¾ã²z
    
27.             ¦sÀÉ
    
28.             xRecond i, stockid.Value & vbTab & "¦sÀɧ¹²¦ " & Format(Time - StartTime, "¦@SS¬í") & vbCrLf
    
29.         End If
    
30.         Set stockid = stockid.Offset(1)
    
31.     Loop
    
32.     IE.Quit
    
33.     Application.DisplayAlerts = False
    
34.     Query_Sh.Delete
    
35.     Application.DisplayAlerts = True
    
36.     Workbooks.Open °O¿ýÀÉ
    
37.     MsgBox "¦@¦s ""(" & i & ") csvÀɧ¹²¦" & vbTab & "¶O®É " & Format(Time - t, "nn¤Àss¬í")
    
38. End Sub
    
39. Private Sub ¼È¦s­¶(temp As String)
    
40.     On Error Resume Next
    
41.     Set Query_Sh = Sheets(temp)
    
42.     If Err.Number = 9 Then
    
43.         Sheets.Add(, Sheets(1)).Name = temp
    
44.         Set Query_Sh = Sheets(temp)
    
45.     End If
    
46. End Sub
    
47. Private Sub ¸ê®Æ¶×¤J()
    
48.     Dim strURL As String
    
49.     strURL = "URL;" & "http://bsr.twse.com.tw/bshtm/bsContent.aspx?StartNumber=" & stockid & "&FocusIndex=All_" & spListCount
    
50.     With Query_Sh
    
51.         .UsedRange.Clear
    
52.         With .QueryTables.Add(strURL, Query_Sh.[a1])
    
53.             .WebFormatting = xlWebFormattingNone
    
54.             .WebSelectionType = xlSpecifiedTables
    
55.             .WebTables = "5,table2"
    
56.             .Refresh 0
    
57.             .Delete
    
58.         End With
    
59.     End With
    
60. End Sub
    
61. Private Sub ¾ã²z()
    
62.     Dim i As Integer
    
63.     With Sheets("temp")
    
64.         SaveDate = Format(.Range("B1"), "YYYYMMDD")
    
65.         With .UsedRange.Range("A:A")
    
66.             .SpecialCells(xlCellTypeConstants, xlTextValues).EntireRow.Delete
    
67.             .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    
68.         End With
    
69.         .UsedRange.Columns("F:J").Cut
    
70.         .Range("A" & .Rows.Count).End(xlUp).Offset(1).Insert Shift:=xlDown
    
71.         .UsedRange.Sort Key1:=.Range("A1"), Order1:=xlAscending, Header:=xlNo
    
72.         .UsedRange.Columns("B:B").Insert Shift:=xlToRight
    
73.         .UsedRange.Columns(1) = SaveDate
    
74.         .UsedRange.Columns(2) = stockid
    
75.          For i = 1 To .UsedRange.Rows.Count
    
76.             .Cells(i, 3) = Left(.Cells(i, 3), 4)
    
77.             .Cells(i, 5) = .Cells(i, 5).Value / 1000
    
78.             .Cells(i, 6) = .Cells(i, 6).Value / 1000
    
79.         Next
    
80.     End With
    
81. End Sub
    
82. Private Sub ¥Ø¿ý(xPath As String)
    
83.     Dim SP As Variant, P As String, i As Integer
    
84.     SP = Split(xPath, "\")
    
85.     P = SP(0)
    
86.     With CreateObject("Scripting.FileSystemObject")
    
87.         For i = 1 To UBound(SP)
    
88.             P = P & "\" & SP(i)
    
89.             If .FolderExists(P) = False Then .CreateFolder (P)
    
90.         Next
    
91.     End With
    
92. End Sub
    
93. Private Sub ¦sÀÉ()
    
94.     Dim CSVfolder As String, CSVfile As String
    
95.     CSVfolder = CsvPath & SaveDate & "\"
    
96.     ¥Ø¿ý CSVfolder
    
97.     CSVfile = CSVfolder & stockid & "_" & SaveDate & ".csv"
    
98.     If Dir(CSVfile) <> "" Then Kill CSVfile
    
99.     Query_Sh.Copy
    
100.     With ActiveWorkbook
     
101.         .SaveAs Filename:=CSVfile, FileFormat:=xlCSV
     
102.         .Close 0
     
103.     End With
     
104. End Sub
     
105. Private Sub xRecond(i As Integer, xSub As String)
     
106.     Dim S As String
     
107.     S = Time & vbTab & Format(Time - t, " ²Änn¤Àss¬í") & vbTab & " ²Ä " & i & " ­ÓCsvÀÉ " & xSub
     
108.     Close #1
     
109.     Open °O¿ýÀÉ For Append As #1
     
110.     Print #1, S
     
111.     Close #1
     
112.     Application.StatusBar = S
     
113. End Sub
     
114. Private Function ¸ê®Æ­¶¼Æ() As Integer   '¨ú±o­¶¼Æ
     
115.     If IE Is Nothing Then
     
116.         Set IE = CreateObject("InternetExplorer.Application")
     
117.         IE.Navigate "http://bsr.twse.com.tw/bshtm/bsMenu.aspx"
     
118.         IE.Visible = True  '¥i¤£Åã¥Ü
     
119.     End If
     
120.     With IE
     
121.         Do:  Loop While .Busy Or IE.ReadyState <> 4
     
122.         With .document
     
123.             .getElementByID("txtTASKNO").Value = stockid
     
124.             .getElementByID("btnOK").Click
     
125.             Do: Loop While IE.Busy Or IE.ReadyState <> 4 Or .getElementByID("sp_ListCount") Is Nothing
     
126.             ¸ê®Æ­¶¼Æ = Val(.getElementByID("sp_ListCount").innertext)
     
127.         End With
     
128.     End With
     
129. End Function

½Æ»s¥N½X

GBKEE

¦^´_ 15# sasho

1. Cells.NumberFormatLocal = "G/³q¥Î®æ¦¡"
   
2. ¥i§ï¦¨(ÁY¤p½d³ò)
   
3. UsedRange.NumberFormatLocal = "G/³q¥Î®æ¦¡"

½Æ»s¥N½X