- 帖子
- 4901
- 主題
- 44
- 精華
- 24
- 積分
- 4916
- 點名
- 91
- 作業系統
- Windows 7
- 軟體版本
- Office 20xx
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台北
- 註冊時間
- 2010-4-30
- 最後登錄
- 2024-4-20
              
|
本帖最後由 Hsieh 於 2011-10-3 22:53 編輯
回復 5# spermbank
我不善於破解
但依你敘述或許可試試在個股基本面分析.xls一般模組
執行更新主程序試試- Sub 更新主程序()
- With ThisWorkbook
- For Each a In .Sheets(1).[A2:A1341] '每個代號循環
- 更新資料 a '執行12檔案更新
- Workbooks("風險評估.xls").Sheets(Array("IS", "ISQ", "BS", "BSQ", "BASIC", "YrPrice", "FR", "CFS", "ISQT")).Copy '複製工作表
- ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & CStr(a) & ".xls" '另存新檔
- Workbooks("營業收入變動.xls").Sheets("Revenue").Copy Before:=Workbooks(CStr(a) & ".xls").Sheets(1) '複製工作表
- 關檔
- Next
- End With
- End Sub
- Sub 更新資料(a)
- Dim Sh As Worksheet, MyURL$, MyQy As QueryTable
- With ThisWorkbook
- fd = .Path & "\基本面\"
- fs = Dir(fd & "*.xls")
- Do Until fs = ""
- With Workbooks.Open(fd & fs)
- For Each Sh In .Sheets
- With Sh
- If .QueryTables.Count > 0 Then
- Set MyQy = .QueryTables(1)
- With .QueryTables(1)
- MyURL = .Connection
- If InStr(MyURL, "StockID") > 0 Then
- k = Val(Split(MyURL, "=")(UBound(Split(MyURL, "="))))
- Else
- k = Val(Split(MyURL, "_")(1))
- End If
- MyURL = Replace(MyURL, k, a)
- .Connection = MyURL '更改查詢
- .BackgroundQuery = False '幕前更新
- .Refresh '更新
- End With
- End If
- End With
- Next
- End With
- fs = Dir()
- Loop
- End With
- End Sub
- Sub 關檔()
- For Each w In Windows
- If w.Caption <> ThisWorkbook.Name Then w.Close 1
- Next
- End Sub
|
|
發表於 2011-10-2 17:26
| 
