Board logo

標題: [發問] [求助]資料查詢沒有回應 [打印本頁]
作者: herhsiu    時間: 2013-10-1 10:36     標題: [求助]資料查詢沒有回應

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

[attach]16206[/attach]
作者: HSIEN6001    時間: 2013-10-1 21:40

回復 1# herhsiu


    應該是溢位問題,改這兩個
(1)Dim i As Long       'Integer  運算溢位,故改為 Long
(2)idx As Long
作者: luhpro    時間: 2013-10-1 23:21

回復 1# herhsiu

你的檔案怪怪的,
我用單步模式跑 Workbook_Open() 程序,
執行到 :
Range("C2") = Year(Date) & Format(Month(Date), "00") & Format(Day(Date), "00")
這一行時VBA執行緒會直接跳到
Function Trans2Mon(str As String)   ~    End Function  這個功能區塊內,
且一直重複著執行此功能,
即便已經執行到 Exit Function 或是 End Function,
照樣下一步還是跑 Function Trans2Mon(str As String) 這行,(即又重頭開始跑...無限迴圈?)
我也看不出來為什麼會發生這樣的現象.

因為搜遍整個專案都沒看到呼叫 Trans2Mon 功能的敘述,
所以我試著把該功能的程序整個都給它 Mark 掉之後,
再按 "海撈" 按鍵程式跑起來就變快了.
另 因為我發現轉檔過程中股票代號都沒隨之更新,
所以我嘗試修改了一下 GetMonData 程序 :
  1.          If [a3] <> "" Then
  2.             [b1] = stkno
  3.             StkName = [a3]
  4.             Exit For
  5.          Else
複製代碼
[attach]16215[/attach]
作者: herhsiu    時間: 2013-10-2 07:08

To luhpro大大:
Trans2Mon 自訂義函數是為了將下載回來的資料日期格式做轉換
==> 將 資料日期：99年02月01日 --> 99/02
看來的確是這個函數造成的,感謝~
作者: GBKEE    時間: 2013-10-2 15:43

本帖最後由 GBKEE 於 2013-10-2 15:51 編輯

回復 4# herhsiu

[attach]16218[/attach]

有辦法將每日資料會成一份
  1.     If .QueryTables.Count = 0 Then
  2. 29.                .QueryTables.Add "URL;" & Qur, .[A1]
  3. 30.            Else
  4. 31.                .QueryTables(1).Connection = "URL;" & Qur
  5. 32.                Msg = True
  6. 33.            End If
  7. 34.           With .QueryTables(1)
複製代碼
回復 3# luhpro
搜遍整個專案都沒看到呼叫 Trans2Mon 功能的敘述,在這裡



[attach]16219[/attach]
作者: HSIEN6001    時間: 2013-10-2 19:39

回復 5# GBKEE
這份股權資料作者來自[笑話一籮筐]部落格的李先生,原始檔案如下
[attach]16224[/attach]

-------------------------------
回復 1# herhsiu
根據您修改的部份源碼,判斷您應該是想要下載所有代號的股權資料
    n = Sheet1.Range("A65536").Rows.End(xlUp).Row
    For id = 2 To n
        Range("D2") = id
        stkno = Sheet1.Cells(id, 1) '個股代碼

因為全部股票資料量,運算會產生溢位,故提醒 Integer  要改為 Long
[attach]16225[/attach]
作者: luhpro    時間: 2013-10-2 23:31

本帖最後由 luhpro 於 2013-10-2 23:32 編輯

回復 5# GBKEE
嗯...有看到了,謝謝你告訴我.

不過就像我上面所說的,
我再次用單步跑過Workbook_Open一遍,
發現即使該功能只有在 Sheets("進階整理") 中才有公式去引用到,
然而即便只是變更 Sheets("股票代碼") 裡的儲存格內容(根本與該Function無關),
那個 Function Trans2Mon 仍然是把所有有引用到該公式的儲存格全部都重新計算一次, (任一Sheet中的任何一個儲存格內容變更,它都會全部都再計算一輪 O.O" )
難怪把那個 Function 拿掉後速度差那麼多.

我試了一下, 把那 12 個儲存格公式改為 :
  1. =CONCATENATE(MID(INDIRECT(ADDRESS(221 - (COLUMN() - 2)  * 20,1,1,1,"近一年資料"),1),6,3),"/",MID(INDIRECT(ADDRESS(221 - (COLUMN() - 2)  * 20,1,1,1,"近一年資料"),1),10,2))
複製代碼
就可以把  Function Trans2Mon 拿掉了,
感覺上速度似乎有比較快.
甚至若把 INDIRECT(ADDRESS(221 - (COLUMN() - 2)  * 20,1,1,1,"近一年資料"),1) 分割出來另用儲存格存放,
公式也能更簡化, 速度應該也會更快.

我想我以後會儘量避免在儲存格公式中引用 Function,
因為非必要的計算動作-loading 太重太多了.
作者: HSIEN6001    時間: 2013-10-3 08:17

Sorry,,,百密一疏
改一下這裡
    Sheets("資料").Range("A" & CStr((idx - 2) * 17 + 1) & ":A" & CStr((idx - 2) * 17 + 17)) = 代號
[attach]16231[/attach]
作者: herhsiu    時間: 2013-10-3 15:57

回復 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
作者: cji3cj6xu6    時間: 2013-12-3 15:38

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

如此應該可行∼
作者: GBKEE    時間: 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
複製代碼
作者: cji3cj6xu6    時間: 2013-12-5 13:20

謝謝GBKEE 大，

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

謝謝！
作者: cji3cj6xu6    時間: 2013-12-5 14:30

我搞定了。
Thanks.
作者: GBKEE    時間: 2013-12-5 14:58

回復 13# cji3cj6xu6
搞定了,要分享一下
作者: cji3cj6xu6    時間: 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
複製代碼
作者: GBKEE    時間: 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
複製代碼
作者: cji3cj6xu6    時間: 2013-12-5 19:32

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



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)