- 帖子
- 94
- 主題
- 28
- 精華
- 0
- 積分
- 145
- 點名
- 0
- 作業系統
- windows
- 軟體版本
- office 2007
- 閱讀權限
- 20
- 註冊時間
- 2011-9-22
- 最後登錄
- 2025-2-25
|
回復 2# luhpro
您好:
不知道如何加入您給我的程式碼，但是更新的時候會再.Refresh這一行出現錯誤。
可以再請多指教一些嗎? 謝謝。
Sub 下載基本資料()
Range("P" & 23).Formula = "更新開始..." '.改
Application.ScreenUpdating = False
Sheets("DDE").Select
x = Application.WorksheetFunction.CountA(Range("A:A")) '欄位有值範圍計算
With ThisWorkbook
For Each a In .Sheets("DDE").Range("A" & 1418, "A" & x - 1).SpecialCells(xlCellTypeConstants).Offset(1) '設定範圍 '==========要減1============
更新資料 a '執行12檔案更新
Workbooks("風險評估.xlsx").Sheets(Array("IS", "ISQ", "BS", "BSQ", "BASIC", "YrPrice", "FR", "CFS", "ISQT")).Copy '複製工作表
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\Base\" & CStr(a) & ".xlsx" '另存新檔
關檔
Next
End With
Sheets("DDE").Select
Range("P" & 23).Formula = "更新結束" '.改
Application.ScreenUpdating = True
End Sub
Sub 更新資料(a)
Dim Sh As Worksheet, MyURL$, MyQy As QueryTable
With ThisWorkbook
fd = .Path & "\基本面\風險評估\"
fs = Dir(fd & "*.xlsx")
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 |
|
發表於 2013-11-16 01:37
| 
