返回列表 上一主題 發帖

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

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

此檔是從集保中心查詢股權分散表,目的是要把股權有集中的個股給篩選出來,可是程式執行一段時間後都會沒有回應,沒有辦法順利跑完,請教先進該如何修正?感激不盡~

Query.zip (76.75 KB)

呵呵~
果然還是G大比較專業~

TOP

本帖最後由 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

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

回復 13# cji3cj6xu6
搞定了,要分享一下
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

我搞定了。
Thanks.

TOP

謝謝GBKEE 大,

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

謝謝!

TOP

本帖最後由 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

你的現象我遇過,
建議你將股票代號帶進去原始檔中,
當原始檔在抓取每檔股票資料時,塞進去1 or 2 秒鐘,
再將你要的資料抓出來。

如此應該可行~

TOP

回復 5# GBKEE

GBKEE大大,程式修改後資料查詢碰到沒有資料的日期(5/1勞動節)會出現錯誤中斷,原本的code卻不會有這種情況,請問該如何解決?謝謝~



    Qur = "http://www.tdcc.com.tw/smWeb/QryStock.jsp?SCA_DATE=" & strDate & "&SqlMethod=StockNo&StockNo=" & stkno & "&StockName=&sub=%ACd%B8%DF"
   
       If Sheet3.QueryTables.Count = 0 Then
            Sheet3.QueryTables.Add "URL;" & Qur, Sheet3.[A3]
            Else
                Sheet3.QueryTables(1).Connection = "URL;" & Qur
                Msg = True
       End If

         With Sheet3.QueryTables(1)
             .Name = "持股分佈"
             .FieldNames = True
             .RowNumbers = False
             .FillAdjacentFormulas = False
             .PreserveFormatting = False
             .RefreshOnFileOpen = False
             .BackgroundQuery = True
             .RefreshStyle = xlOverwriteCells
             .SavePassword = False
             .SaveData = True
             .AdjustColumnWidth = False
             .RefreshPeriod = 0
             .WebSelectionType = xlSpecifiedTables
             .WebFormatting = xlWebFormattingNone
             .WebTables = "6,7,8"
             .WebPreFormattedTextToColumns = True
             .WebConsecutiveDelimitersAsOne = True
             .WebSingleBlockTextImport = False
             .WebDisableDateRecognition = False
             .WebDisableRedirections = False
             .Refresh BackgroundQuery:=False
         End With

TOP

        靜思自在 : 人生最大的成就是從失敗中站起來。
返回列表 上一主題