(不定期更新)使用VBA解決 excel web 查詢無法匯入、匯入太慢的股市資料

rainbowsperm wrote:
但讀清單跑, 也沒發生錯誤訊息, 但跑了20-30檔, EXCEL就一樣沒反應~~試過重裝excel也不行~~

Sub 更新()
     Application.Calculation = xlCalculationManual
     ThisWorkbook.Activate
     Call 下載財報(ThisWorkbook.Sheets("總覽").Range("J1").Value)
     Call 股利政策
     Call 改變顏色
     Call 股利連續增長
     Application.Calculation = xlCalculationAutomatic
End Sub

Private Sub Workbook_Open()

    Dim template As Excel.Workbook, lastrow As Integer, i As Integer

    If MsgBox("是否進行更新作業？", vbQuestion + vbDefaultButton2 + vbYesNo) = vbNo Then
        Exit Sub '取消更新
    End If
    
    lastrow = Sheets("倉儲雪球股").Range("a1").CurrentRegion.Rows.Count
    Set template = Workbooks.Open(ThisWorkbook.Path & "\" & "個股資料匯入範本 - 複製新方法array.xlsm", , False)
        
    Application.Wait (Now + TimeValue("0:00:10"))
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual
    
    For i = 2 To lastrow
    
        template.Activate
        template.Sheets(1).Range("J1").Value = Sheets("倉儲雪球股").Cells(i, 1)
        DoEvents
        Application.Run "'" & template.Name & "'" & "!Module2.更新"
        template.SaveAs (ThisWorkbook.Path & "\" & Sheets("倉儲雪球股").Cells(i, 1) & Sheets("倉儲雪球股").Cells(i, 2) & ".xlsm")
'補充：如果電腦效能不好，這裡最好等個1~3秒，等一下excel存檔
        Application.Wait (Now + TimeValue("0:00:1"))
    Next i
        
    template.Close
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
   
    Set template = Nothing

End Sub

rainbowsperm wrote:
目前想抓取表格資料, 不過要抓取的表格資料是在 第一個表格(也就是下面連結)裡最後一欄的連結點進去後的表格, 請問這可以用什麼方式做到呢?
https://www.tpex.org.tw/web/bond/publish/convertible_bond_search/memo.php?l=zh-tw

       
        Set link = HTMLsourcecode.getelementsbytagname("a")
        For Each a In link
            If InStr(a.href, "http://mops.twse.com.tw/mops/web/t120sg01?TYPEK=&bond_id=") > 0 Then
                i = i + 1
                Cells(i, 1) = "'" & Split(Split(a.href, "bond_id=")(1), "&bond_kind")(0)
                Cells(i, 2) = Replace(a.href, "http://", "https://")
            End If
        Next

rainbowsperm wrote:
後來才發現此網站有CSV
https://www.tpex.org.tw/web/bond/publish/convertible_bond_search/memo_download.php?d=issue.txt
可惜用了之前的方法要轉碼時會卡住所以放棄了 哈哈

rainbowsperm wrote:
可以請大大稍微解釋一下下面這串code嗎? 大概懂它的作用, 只是有點複雜不太理解~~><

rainbowsperm wrote:
另外想請問成功抓取表格後, 有辦法快速找到當中的字串嗎?
如 "轉(交)換期間："
因目前是用for loop的方式去尋找字串, 想說有沒有更有效率的方法

snare wrote:
可參考200樓、700(恕刪)

rainbowsperm wrote:
收到, 謝謝大神耐心的教導, 馬上來試試

snare wrote:
我發現您把780樓的(恕刪)

rainbowsperm wrote:
snare大神不好意(恕刪)