麻辣家族討論版版 - Powered by Discuz! Board

Sub abc()
Dim Theurl As String, Sdate
Dim URL As String, xDate As String, A As Date
A = Range("A2").Value
xDate = Format(A, "E/MM/DD")
Theurl = "http://www.otc.org.tw/ch/stock/3insti/DAILY_TradE/3itrade_download.php?t=D&d=" & xDate & "&s=0"
With ActiveSheet.QueryTables.Add(Connection:="URL;" & Theurl, Destination:=Range("B3"))
.BackgroundQuery = True
.RefreshStyle = xlOverwriteCells
.RefreshPeriod = 0
.AdjustColumnWidth = False
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
'.WebTables = "1,2,3,4"
.WebDisableDateRecognition = True '關閉日期辨識
.Refresh BackgroundQuery:=False
.ResultRange.Columns(1).TextToColumns Destination:=.ResultRange.Cells(1), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1 _
), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array _
(20, 1)), TrailingMinusNumbers:=True
'TextToColumns 方法 (資料剖析)的參數可錄製得到
'ResultRange.Columns(1):weby資料的第一欄
'ResultRange.Cells(1) :weby資料的第一個Cells(儲存格)
'.Delete
End With
End Sub

複製代碼

Sub 巨集1()
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://www.gretai.org.tw/web/stock/3insti/daily_trade/3itrade_print.php?l=zh-tw&t=D&d=103/11/28&s=0,asc,0" _
, Destination:=Range("$A$1"))
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.Refresh BackgroundQuery:=False
.Delete
End With
End Sub

複製代碼

Option Explicit
Sub abc()
Dim Theurl As String, xDate As String, AR()
Range("A2") = "2014/12/4"
xDate = Format(Range("A2"), "E/MM/DD")
Theurl = "http://www.gretai.org.tw/web/stock/3insti/daily_trade/3itrade_hedge_download.php?l=zh-tw&t=D&d=" & xDate '& "&s=0"
Application.ScreenUpdating = False
With Workbooks.Open(Theurl)
AR = .Sheets(1).UsedRange.Value
.Close False
End With
With ActiveSheet
.UsedRange.Clear
.[A1].Resize(UBound(AR, 1), UBound(AR, 2)) = AR
End With
Application.ScreenUpdating = True
End Sub

複製代碼