集保戶股權分散表查詢抓每週資料 - Excel程式區

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

11^# 跳轉到 »

發表於 2015-9-16 06:11 | 只看該作者

本帖最後由 GBKEE 於 2015-9-16 06:12 編輯

回復 10# espionage
網頁上的股票代號查詢後會不會消失不見.端看各網頁原始碼的寫法.

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

TOP

s13983037

中學生 Rank: 2

帖子: 60
主題: 26
精華: 0
積分: 93
點名: 0
作業系統: Windows
軟體版本: Windows 7
閱讀權限: 20
註冊時間: 2014-9-8
最後登錄: 2020-4-15

12^#

發表於 2015-9-27 01:33 | 只看該作者

回復 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

TOP

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

13^#

發表於 2015-9-27 06:40 | 只看該作者

回復 12# s13983037
試試看

Option Explicit
Sub Ex()
Dim Ar(), a As Variant, i As Integer, stkno As String, Qur As String, DateVar As Integer, Sh As Worksheet
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
stkno = InputBox("輸入股票代號", "股票代號", 2313) '
If stkno = "" Then Exit Sub
Set Sh = ActiveSheet '指定工作表
With Sh
For DateVar = 0 To UBound(Ar)
Qur = "http://www.tdcc.com.tw/smWeb/QryStock.jsp?SCA_DATE=" & Ar(DateVar) & "&SqlMethod=StockNo&StockNo=" & stkno & "&StockName=&sub=%ACd%B8%DF"
.QueryTables.Add "URL;" & Qur, .Cells(1 + (DateVar * 27), "A")
'.Cells(1 + (DateVar * 27), "A") A欄間隔 27列
With .QueryTables(1)
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "6,7,8"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
Sh.Names(.Name).Delete '刪掉工作表上的名稱
.Delete '刪掉這QueryTable
End With
Next
End With
End Sub