- 帖子
- 549
- 主題
- 152
- 精華
- 0
- 積分
- 691
- 點名
- 0
- 作業系統
- WIN7
- 軟體版本
- OFFICE 2010
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2013-8-10
- 最後登錄
- 2022-9-7
 
|
7#
發表於 2014-12-2 07:54
| 只看該作者
本帖最後由 PKKO 於 2014-12-2 07:57 編輯
回復 5# GBKEE
超版大大,感謝您的回覆
但以下兩行程式碼皆無反應
Sh(1).UsedRange.Clear
Sh(2).Copy Sh(1).Range("a1")
小弟嘗試了一下仍無法用SET的方式成功
因此改為以下程式碼,目前已可正常使用
存取速度大約兩秒以內(可能是SHEET不多的關係目前還滿快的)
感謝大大,po上小弟實際的程式碼- Sub 儲存前儲存至資料庫()
- Application.ScreenUpdating = False '關閉螢幕
- Application.DisplayAlerts = False '關閉警告視窗
- Dim Xpath As String, A As Variant, sh As Worksheet
- W1 = ThisWorkbook.Name
- Xpath = "C:\Users\apple\Google 雲端硬碟\Excel\"
- Workbooks("資料庫.xlsb").Close False '儲存開啟中的檔案,此開啟中的檔須先關閉
- Workbooks.Open (Xpath & "資料庫.xlsb")
- For Each sh In Workbooks(W1).Sheets
- Workbooks("資料庫.xlsb").Sheets(sh.Name).UsedRange.Clear
- Workbooks(W1).Sheets(sh.Name).[a1].CurrentRegion.Copy
- Workbooks("資料庫.xlsb").Sheets(sh.Name).Activate'有點多餘的程式碼,但不太會改
- Range("a1").Select'我只是要讓下面貼到a1
- Workbooks("資料庫.xlsb").Sheets(sh.Name).Paste'直接貼上不會貼到[A1],因此多了上面兩行程式碼
- Next
- Workbooks("資料庫.xlsb").Close True
- Workbooks.Open Xpath & "資料庫.xlsb", ReadOnly:=True '再度開啟檔案(唯讀)
- Application.WindowState = xlMinimized '將資料庫最小化
- Application.CutCopyMode = xlCopy '清除剪貼簿
- Application.ScreenUpdating = True
- Application.DisplayAlerts = True
- MsgBox "操作成功"
- End Sub
複製代碼 |
|