- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
14#
發表於 2014-6-25 13:20
| 只看該作者
本帖最後由 GBKEE 於 2014-6-25 13:39 編輯
回復 13# sasho
你原本的 Sub 執行(),在我的PC沒有你所說的越來越慢的情形.速度與Main() 的記錄檔差不多.
整理一下,附上 Sub Main() 的記錄檔
 Ex.rar (10.87 KB)
- Option Explicit
- Dim IE As Object, Query_Sh As Worksheet, CsvPath As String, SaveDate As String
- Dim t As Date, StartTime As Date, 記錄檔 As String, stockid As Range, spListCount As Integer
- Sub Main()
- Dim i As Integer
- t = Time
- StartTime = Time
- CsvPath = "D:\TSE\"
- 目錄 CsvPath
- 記錄檔 = CsvPath & "Main_Record.TXT"
- If Dir(記錄檔) <> "" Then Kill 記錄檔
- 暫存頁 "temp"
- xRecond 0, "程式開始執行" & vbCrLf
- Set stockid = Sheets("工作表1").Range("A2")
- stockid.Parent.Activate
- Do While stockid <> ""
- Application.ScreenUpdating = True
- stockid.Select
- Application.ScreenUpdating = False
- StartTime = Time
- spListCount = 資料頁數
- If spListCount > 0 Then
- i = i + 1
- xRecond i, stockid & vbTab & "資料匯入"
- 資料匯入
- 整理
- 存檔
- xRecond i, stockid.Value & vbTab & "存檔完畢 " & Format(Time - StartTime, "共SS秒") & vbCrLf
- End If
- Set stockid = stockid.Offset(1)
- Loop
- IE.Quit
- Application.DisplayAlerts = False
- Query_Sh.Delete
- Application.DisplayAlerts = True
- Workbooks.Open 記錄檔
- MsgBox "共存 ""(" & i & ") csv檔完畢" & vbTab & "費時 " & Format(Time - t, "nn分ss秒")
- End Sub
- Private Sub 暫存頁(temp As String)
- On Error Resume Next
- Set Query_Sh = Sheets(temp)
- If Err.Number = 9 Then
- Sheets.Add(, Sheets(1)).Name = temp
- Set Query_Sh = Sheets(temp)
- End If
- End Sub
- Private Sub 資料匯入()
- Dim strURL As String
- strURL = "URL;" & "http://bsr.twse.com.tw/bshtm/bsContent.aspx?StartNumber=" & stockid & "&FocusIndex=All_" & spListCount
- With Query_Sh
- .UsedRange.Clear
- With .QueryTables.Add(strURL, Query_Sh.[a1])
- .WebFormatting = xlWebFormattingNone
- .WebSelectionType = xlSpecifiedTables
- .WebTables = "5,table2"
- .Refresh 0
- .Delete
- End With
- End With
- End Sub
- Private Sub 整理()
- Dim i As Integer
- With Sheets("temp")
- SaveDate = Format(.Range("B1"), "YYYYMMDD")
- With .UsedRange.Range("A:A")
- .SpecialCells(xlCellTypeConstants, xlTextValues).EntireRow.Delete
- .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
- End With
- .UsedRange.Columns("F:J").Cut
- .Range("A" & .Rows.Count).End(xlUp).Offset(1).Insert Shift:=xlDown
- .UsedRange.Sort Key1:=.Range("A1"), Order1:=xlAscending, Header:=xlNo
- .UsedRange.Columns("B:B").Insert Shift:=xlToRight
- .UsedRange.Columns(1) = SaveDate
- .UsedRange.Columns(2) = stockid
- For i = 1 To .UsedRange.Rows.Count
- .Cells(i, 3) = Left(.Cells(i, 3), 4)
- .Cells(i, 5) = .Cells(i, 5).Value / 1000
- .Cells(i, 6) = .Cells(i, 6).Value / 1000
- Next
- End With
- End Sub
- Private Sub 目錄(xPath As String)
- Dim SP As Variant, P As String, i As Integer
- SP = Split(xPath, "\")
- P = SP(0)
- With CreateObject("Scripting.FileSystemObject")
- For i = 1 To UBound(SP)
- P = P & "\" & SP(i)
- If .FolderExists(P) = False Then .CreateFolder (P)
- Next
- End With
- End Sub
- Private Sub 存檔()
- Dim CSVfolder As String, CSVfile As String
- CSVfolder = CsvPath & SaveDate & "\"
- 目錄 CSVfolder
- CSVfile = CSVfolder & stockid & "_" & SaveDate & ".csv"
- If Dir(CSVfile) <> "" Then Kill CSVfile
- Query_Sh.Copy
- With ActiveWorkbook
- .SaveAs Filename:=CSVfile, FileFormat:=xlCSV
- .Close 0
- End With
- End Sub
- Private Sub xRecond(i As Integer, xSub As String)
- Dim S As String
- S = Time & vbTab & Format(Time - t, " 第nn分ss秒") & vbTab & " 第 " & i & " 個Csv檔 " & xSub
- Close #1
- Open 記錄檔 For Append As #1
- Print #1, S
- Close #1
- Application.StatusBar = S
- End Sub
- Private Function 資料頁數() As Integer '取得頁數
- If IE Is Nothing Then
- Set IE = CreateObject("InternetExplorer.Application")
- IE.Navigate "http://bsr.twse.com.tw/bshtm/bsMenu.aspx"
- IE.Visible = True '可不顯示
- End If
- With IE
- Do: Loop While .Busy Or IE.ReadyState <> 4
- With .document
- .getElementByID("txtTASKNO").Value = stockid
- .getElementByID("btnOK").Click
- Do: Loop While IE.Busy Or IE.ReadyState <> 4 Or .getElementByID("sp_ListCount") Is Nothing
- 資料頁數 = Val(.getElementByID("sp_ListCount").innertext)
- End With
- End With
- End Function
|
|
發表於 2014-6-7 01:53
| 
