12
返回列表 上一主題 發帖

[發問] [求助]資料查詢沒有回應

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
11# 跳轉到 »
發表於 2013-12-4 18:31 | 只看該作者
本帖最後由 GBKEE 於 2014-1-1 16:37 編輯

回復 9# herhsiu
沒看到你的回覆,不好意思,遲至今日才回覆
試試看
  1. Option Explicit
  2. Sub 集保戶股權分散表查詢_WEB()
  3.     Dim Ar(), A, i As Integer, strDate As String, stkno As String, Qur As String
  4.     With CreateObject("InternetExplorer.Application")
  5.         .Navigate "http://www.tdcc.com.tw/smWeb/QryStock.jsp"
  6.         Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
  7.         Set A = .document.All.tags("option") '資料日期的內容
  8.         ReDim Ar(A.Length - 1)
  9.         For i = 0 To A.Length - 1
  10.             Ar(i) = A(i).innerHTML
  11.         Next
  12.         .Quit
  13.     End With
  14.     strDate = Ar(0) '導入當月日期
  15.     Do
  16.         strDate = InputBox(Join(Ar, vbTab), "集保戶股權分散表查詢 之 有效日期", strDate)
  17.         If strDate = "" Then Exit Sub
  18.      
  19.     Loop Until IsNumeric(Application.Match(strDate, Ar, 0))
  20.     stkno = InputBox("輸入股票代號", "股票代號", 2317)    '
  21.     If stkno = "" Then Exit Sub
  22.     Qur = "http://www.tdcc.com.tw/smWeb/QryStock.jsp?SCA_DATE=" & strDate & "&SqlMethod=StockNo&StockNo=" & stkno & "&StockName=&sub=%ACd%B8%DF"
  23.     With ActiveSheet
  24.         If .QueryTables.Count = 0 Then
  25.             .QueryTables.Add "URL;" & Qur, .[A1]
  26.         Else
  27.             .QueryTables(1).Connection = "URL;" & Qur
  28.         End If
  29.         With .QueryTables(1)
  30.             .WebSelectionType = xlSpecifiedTables
  31.             .WebFormatting = xlWebFormattingNone
  32.             .WebTables = "6,7,8"
  33.             .WebPreFormattedTextToColumns = True
  34.             .WebConsecutiveDelimitersAsOne = True
  35.             .WebSingleBlockTextImport = False
  36.             .WebDisableDateRecognition = False
  37.             .WebDisableRedirections = False
  38.             .Refresh BackgroundQuery:=False
  39.         End With
  40.     End With
  41. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

cji3cj6xu6

帖子
112 
主題
19 
精華
0 
積分
136 
點名
0  
作業系統
window 
軟體版本
excel 
閱讀權限
20 
性別
男 
註冊時間
2013-3-12 
最後登錄
2022-11-29 

論壇贊助勳章
12#
發表於 2013-12-5 13:20 | 只看該作者
謝謝GBKEE 大，

但請問一下，如何抓下"集保戶股權分散表查詢 之 有效日期"
假設我想將他存到Sheet1 "A1 ~ A10"

謝謝！

TOP

cji3cj6xu6

帖子
112 
主題
19 
精華
0 
積分
136 
點名
0  
作業系統
window 
軟體版本
excel 
閱讀權限
20 
性別
男 
註冊時間
2013-3-12 
最後登錄
2022-11-29 

論壇贊助勳章
13#
發表於 2013-12-5 14:30 | 只看該作者
我搞定了。
Thanks.

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
14#
發表於 2013-12-5 14:58 | 只看該作者
回復 13# cji3cj6xu6
搞定了,要分享一下
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

cji3cj6xu6

帖子
112 
主題
19 
精華
0 
積分
136 
點名
0  
作業系統
window 
軟體版本
excel 
閱讀權限
20 
性別
男 
註冊時間
2013-3-12 
最後登錄
2022-11-29 

論壇贊助勳章
15#
發表於 2013-12-5 15:21 | 只看該作者
sheet1 存放一年的股權變換資料
sheet2 存放一年的股權有效日期
sheet3 抓下每月股權的股權變換資料並存放到sheet1
sheet4 股票代號，屆時這裡是可以變數方式來抓取想觀察的股權變換資料

於是將G大的格式修改如下：
  1. Sub 集保戶股權分散表查詢_WEB()
  2.     Dim Ar(), A, i As Integer, strDate As String, stkno As String, Qur As String
  3.     With CreateObject("InternetExplorer.Application")
  4.         .Navigate "http://www.tdcc.com.tw/smWeb/QryStock.jsp"
  5.         Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
  6.         Set A = .document.All.tags("option") '資料日期的內容
  7.         ReDim Ar(A.Length - 1)
  8.         For i = 0 To A.Length - 1
  9.             Ar(i) = A(i).innerHTML
  10.             If InStr(Ar(i), Format(Date, "YYYYMM")) Then strDate = Ar(i) '導入當月日期
  11.         Next
  12.         .Quit
  13.     End With
  14.    
  15.     For DQ = 1 To 3
  16.     Sheets(DQ).Select
  17.     Cells.Clear
  18.     Next DQ
  19.         
  20.     For i = 1 To 12
  21.     Sheets(2).Select
  22.     Range("a" & i + 1).Value = Ar(i)
  23.     Next i
  24.    
  25.     Range("a" & 14).Value = Ar
  26.    
  27.     With Worksheets(2)              'sorting
  28.       Range("A1:ac20").Sort _
  29.       Key1:=.Range("a1"), _
  30.       Order1:=xlDescending, _
  31.       Header:=xlYes, _
  32.       Orientation:=xlTopToBottom
  33.     End With
  34. 'End Sub
  35.    
  36.     TotalDate2 = 1
  37.             
  38.     For Totaldate = 2 To 14
  39.     'Do
  40.     '    strDate = InputBox(Join(Ar, vbTab), "集保戶股權分散表查詢 之 有效日期", strDate)
  41.      strDate = Sheets(2).Range("a" & Totaldate)
  42.     '    If strDate = "" Then Exit Sub
  43.      
  44.     'Loop Until IsNumeric(Application.Match(strDate, Ar, 0))
  45.    
  46.     stkno = Sheets(4).Range("a1")    '
  47.    
  48.     If stkno = "" Then Exit Sub
  49.     Qur = "http://www.tdcc.com.tw/smWeb/QryStock.jsp?SCA_DATE=" & strDate & "&SqlMethod=StockNo&StockNo=" & stkno & "&StockName=&sub=%ACd%B8%DF"
  50.     If Sheets(3).QueryTables.Count = 0 Then
  51.         Sheets(3).QueryTables.Add "URL;" & Qur, Sheets(3).[A1]
  52.     Else
  53.         Sheets(3).QueryTables(1).Connection = "URL;" & Qur
  54.     End If
  55.     With Sheets(3).QueryTables(1)
  56.         .Name = "持股分佈"
  57.         .FieldNames = True
  58.         .RowNumbers = False
  59.         .FillAdjacentFormulas = False
  60.         .PreserveFormatting = False
  61.         .RefreshOnFileOpen = False
  62.         .BackgroundQuery = True
  63.         .RefreshStyle = xlOverwriteCells
  64.         .SavePassword = False
  65.         .SaveData = True
  66.         .AdjustColumnWidth = False
  67.         .RefreshPeriod = 0
  68.         .WebSelectionType = xlSpecifiedTables
  69.         .WebFormatting = xlWebFormattingNone
  70.         .WebTables = "6,7,8"
  71.         .WebPreFormattedTextToColumns = True
  72.         .WebConsecutiveDelimitersAsOne = True
  73.         .WebSingleBlockTextImport = False
  74.         .WebDisableDateRecognition = False
  75.         .WebDisableRedirections = False
  76.         .Refresh BackgroundQuery:=False
  77.     End With
  78.    
  79.     Worksheets(3).Select                       '收集資料到sheet1
  80.     Range("a3:e21").Select
  81.     Application.CutCopyMode = False
  82.     Selection.Copy
  83.    
  84.    
  85.     Worksheets(1).Select
  86.     Range("a" & TotalDate2).Select
  87.     ActiveSheet.Paste
  88.     TotalDate2 = TotalDate2 + 20
  89.    
  90.     Next Totaldate
  91. End Sub
複製代碼

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
16#
發表於 2013-12-5 17:09 | 只看該作者
本帖最後由 GBKEE 於 2013-12-5 17:12 編輯

回復 15# cji3cj6xu6
抓下每月股權的股權變換資料直接放到Sheets(1)
  1. Option Explicit
  2. Sub 集保戶股權分散表查詢_WEB()
  3.     Dim Ar(), A, i As Integer, strDate As String, stkno As String, Qur As String, e As Variant
  4.     With CreateObject("InternetExplorer.Application")
  5.         .Navigate "http://www.tdcc.com.tw/smWeb/QryStock.jsp"
  6.         Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
  7.         Set A = .document.All.tags("option") '資料日期的內容
  8.         ReDim Ar(A.Length - 1)
  9.         For i = 0 To A.Length - 1
  10.             Ar(i) = A(i).innerHTML
  11.         Next
  12.         .Quit
  13.     End With
  14.     stkno = Sheets(4).Range("a1")
  15.     If stkno = "" Then Exit Sub
  16.     With Sheets(1)
  17.         .Cells.Clear
  18.         For Each e In .Names
  19.             e.Delete          '刪掉QueryTable的名稱
  20.         Next
  21.         For i = 0 To UBound(Ar)
  22.             strDate = Ar(i)   '集保戶股權分散表查詢 之 有效日期"
  23.         Qur = "http://www.tdcc.com.tw/smWeb/QryStock.jsp?SCA_DATE=" & strDate & "&SqlMethod=StockNo&StockNo=" & stkno & "&StockName=&sub=%ACd%B8%DF"
  24.         With .QueryTables.Add("URL;" & Qur, .Cells(.Range("B" & Rows.Count).End(xlUp).Row + 1, 1))
  25.         .WebSelectionType = xlSpecifiedTables
  26.         .WebFormatting = xlWebFormattingNone
  27.         .WebTables = "6,7,8"
  28.         .Refresh BackgroundQuery:=False
  29.         If i = 0 Then
  30.            .ResultRange.Range("2:2,4:4").Delete  'QueryTable:空白列
  31.         ElseIf i > 0 Then
  32.         .ResultRange.Range("1:2,4:4").Delete     'QueryTable: "聯電股份有限公司 集保戶股權分散表"&空白列
  33.         End If
  34.         End With
  35.         Next
  36.         .Rows(1).Delete     'Sheets(1)第1列
  37.     End With
  38. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

cji3cj6xu6

帖子
112 
主題
19 
精華
0 
積分
136 
點名
0  
作業系統
window 
軟體版本
excel 
閱讀權限
20 
性別
男 
註冊時間
2013-3-12 
最後登錄
2022-11-29 

論壇贊助勳章
17#
發表於 2013-12-5 19:32 | 只看該作者
呵呵~
果然還是G大比較專業~

TOP

        靜思自在 : 人生沒有所有權，只有生命的使用權。
12
返回列表 上一主題