![]() ![]() ![]() |
|
|
|
2009/05/01 22:26:05瀏覽15202|回應4|推薦0 | |
應網友的要求寫了這個程式,底下 SaveTrans() 會新增一張工作表,然後從 Yam 天空財金網站把指定股號的 (當日) "券商進出" 資料匯入工作表,用法就像 GetTransInfo() 裡的方式。
Sub GetTransInfo() SaveTrans ("2412") SaveTrans ("2330") End Sub Sub SaveTrans(stockNo As String) ActiveWorkbook.Worksheets.Add With ActiveSheet.QueryTables.Add(Connection:= _ "URL;http://yamstock.megatime.com.tw/asp/stockinfo/ps_top.asp?m=all&stockid=" & _ stockNo & "&name1=D2&index1=6", _ Destination:=ActiveSheet.Range("A1")) .Name = "Part1" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .BackgroundQuery = True .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .WebSelectionType = xlSpecifiedTables .WebFormatting = xlWebFormattingNone .WebTables = "8" .WebConsecutiveDelimitersAsOne = True .WebSingleBlockTextImport = False .WebDisableDateRecognition = False .WebDisableRedirections = False .Refresh BackgroundQuery:=False End With With ActiveSheet.QueryTables.Add(Connection:= _ "URL;http://yamstock.megatime.com.tw/asp/stockinfo/ps_top.asp?m=all&stockid=" & _ stockNo & "&name1=D2&index1=6" , _ Destination:=ActiveSheet.Range("A3")) .Name = "Part2" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .BackgroundQuery = True .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .WebSelectionType = xlSpecifiedTables .WebFormatting = xlWebFormattingNone .WebTables = "10" .WebConsecutiveDelimitersAsOne = True .WebSingleBlockTextImport = False .WebDisableDateRecognition = False .WebDisableRedirections = False .Refresh BackgroundQuery:=False End With RowToCut = ActiveSheet.[A65536].End(xlUp).Row + 1 With ActiveSheet.QueryTables.Add(Connection:= _ "URL;http://yamstock.megatime.com.tw/asp/stockinfo/ps_top.asp?m=all&stockid=" & _ stockNo & "&name1=D2&index1=6" _ , Destination:=ActiveSheet.[A65536].End(xlUp).Offset(1, 0)) .Name = "Part3" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .BackgroundQuery = True .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .WebSelectionType = xlSpecifiedTables .WebFormatting = xlWebFormattingNone .WebTables = "11" .WebConsecutiveDelimitersAsOne = True .WebSingleBlockTextImport = False .WebDisableDateRecognition = False .WebDisableRedirections = False .Refresh BackgroundQuery:=False End With Rows(RowToCut).Delete Shift:=xlUp End Sub |
|
( 興趣嗜好|電腦3C ) |