- 帖子
- 60
- 主題
- 26
- 精華
- 0
- 積分
- 93
- 點名
- 0
- 作業系統
- Windows
- 軟體版本
- Windows 7
- 閱讀權限
- 20
- 註冊時間
- 2014-9-8
- 最後登錄
- 2020-4-15
|
回復 9# GBKEE
Hi GBKEE您好
看到您的程式碼 想把他修正成 個股的集保日期
當第一筆日期輸入時填入 A1欄中
但是第二筆資料輸入時填入A28欄中
以此類推每一筆資料填入後都需間隔28欄位,
目前我只有修正到可以重複填入日期的部分,請教GBKEE 前輩 不知要如何修改,可否提點迷津 感謝您\QQ/
以下為修正程式碼
Dim Ar(), a, i As Integer, strDate As String, stkno As String, Qur As String
With CreateObject("InternetExplorer.Application")
.Navigate "http://www.tdcc.com.tw/smWeb/QryStock.jsp"
Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
Set a = .Document.ALL.tags("option") '資料日期的內容
ReDim Ar(a.Length - 1)
For i = 0 To a.Length - 1
Ar(i) = a(i).innerHTML
Next
.Quit
End With
For DateVar = 0 To 28
strDate = Ar(DateVar) '導入當月日期
Do
strDate = InputBox(Join(Ar, vbTab), "集保戶股權分散表查詢 之 有效日期", strDate)
If strDate = "" Then Exit Sub
Loop Until IsNumeric(Application.Match(strDate, Ar, 0))
stkno = InputBox("輸入股票代號", "股票代號", 2313) '
If stkno = "" Then Exit Sub
Qur = "http://www.tdcc.com.tw/smWeb/QryStock.jsp?SCA_DATE=" & strDate & "&SqlMethod=StockNo&StockNo=" & stkno & "&StockName=&sub=%ACd%B8%DF"
With ActiveSheet
For WriteDate = 1 To 1
If .QueryTables.Count = 0 Then
.QueryTables.Add "URL;" & Qur, .[A & WriteDate * 28 * (WriteDate) ]
Else
.QueryTables(1).Connection = "URL;" & Qur
End If
With .QueryTables(1)
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "6,7,8"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Next
End With
Next |
|
發表於 2015-9-27 01:33
| 