Board logo

標題: [發問] 如何讓A檔儲存在"X檔",讓"X檔"當作資料庫 [打印本頁]
作者: PKKO    時間: 2014-11-26 04:19     標題: 如何讓A檔儲存在"X檔",讓"X檔"當作資料庫

目的是: 讓A檔可以在按下儲存前,將全部的檔案內容存到X檔當作資料庫
而X檔平常都以唯讀狀態開啟,每五分鐘重新開啟一次(以維持最新狀態)=>這個部份我會

X檔的內容本身會有A檔的所有分頁
假設兩個檔位置都在  "P:\REPORT\Daily Check"
檔案名稱為"A.xlsb","X.xlsb"


Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Call 儲存前儲存至資料庫            '已開啟檔案A檔,並且在A檔儲存前按下
End Sub

但要如何撰寫這個程式碼可以達到最快的效果?
Sub 儲存前儲存至資料庫
       '程式內容
End Sub
作者: GBKEE    時間: 2014-11-27 14:50

回復 1# PKKO
是這樣嗎?
試試看
  1. Sub 儲存前儲存至資料庫()
  2.     Dim Xpath  As String
  3.     Xpath "P:\REPORT\Daily Check\"
  4.     Workbooks("x.xlsb").Close False  '儲存開啟中的檔案,此開啟中的檔須先關閉
  5.     Application.DisplayAlerts = False
  6.     ThisWorkbook.SaveCopyAs Xpath & "x.xlsb"  'ThisWorkbook -> 這程式在 "A.xlsb"的專案模組中
  7.     Application.DisplayAlerts = True
  8.     Workbooks.Open Xpath & "x.xlsb", ReadOnly:=True  '再度開啟檔案(唯讀)
  9. End Sub
複製代碼
作者: PKKO    時間: 2014-11-28 05:18

回復 2# GBKEE

感謝超版大大,下面學習了另存新檔並非一定要影響本身的檔案視窗
ThisWorkbook.SaveCopyAs Xpath & "x.xlsb"  'ThisWorkbook -> 這程式在 "A.xlsb"的專案模組中

但我本身的問題有個不同點
檔案有A檔,B檔~F檔
資料庫的檔案只有一個X檔(因此用此方法則不妥)

何種方式在於A檔的1~10個分頁"覆蓋"X檔的相同名稱分頁會比較快呢~?
作者: joey0415    時間: 2014-11-28 13:06

回復 3# PKKO

放在真正的資料庫非excel中，最快最穩又不容易出錯

以前我也做類似的方法，之後慢慢成真的資料庫就沒有什麼問題
作者: GBKEE    時間: 2014-12-1 13:52

本帖最後由 GBKEE 於 2014-12-2 08:35 編輯

回復 3# PKKO
  1. Sub 儲存前儲存至資料庫()
  2.     Dim Xpath  As String, Sh(1 To 2) As Worksheet, Wo(1 To 2) As Workbook, A As Variant
  3.     Xpath = "P:\REPORT\Daily Check\"
  4.     Set Wo(1) = Workbooks("x.xlsb")
  5.     Wo(1).Close False   '儲存開啟中的檔案,此開啟中的檔須先關閉
  6.     Set Wo(1) = Workbooks.Open(Xpath & "x.xlsb")
  7.     For Each A In Array("A.xlsb", "b.xlsb", "f.xlsb") '檔案有A檔,B檔~F檔
  8.         Set Wo(2) = Workbooks.Open(Xpath & A)
  9.         For Each Sh(2) In Wo(2).Sheets
  10.             On Error Resume Next
  11.             Set Sh(1) = Wo(1).Sheets(Sh(2).Name)
  12.             If Err <> 0 Then
  13.                 Sh(2).Copy , Wo(1).Sheets(Wo(1).Sheets.Count)
  14.                 Err.Clear
  15.                 On Error GoTo 0
  16.             Else
  17.                 Sh(1).UsedRange.Clear
  18.                 Sh(2).UsedRange.Copy Sh(1).Range("a1")
  19.             End If
  20.         Next
  21.         Wo(2).Close False
  22.     Next
  23.     Wo(1).Close True
  24.     Workbooks.Open Xpath & "x.xlsb", ReadOnly:=True  '再度開啟檔案(唯讀)
  25. End Sub
複製代碼
作者: PKKO    時間: 2014-12-2 05:05

回復 5# GBKEE


    感謝大大!待會就來試一下
作者: PKKO    時間: 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上小弟實際的程式碼
  1. Sub 儲存前儲存至資料庫()
  2.     Application.ScreenUpdating = False '關閉螢幕
  3.     Application.DisplayAlerts = False '關閉警告視窗
  4.     Dim Xpath  As String, A As Variant, sh As Worksheet
  5.     W1 = ThisWorkbook.Name
  6.     Xpath = "C:\Users\apple\Google 雲端硬碟\Excel\"
  7.     Workbooks("資料庫.xlsb").Close False   '儲存開啟中的檔案,此開啟中的檔須先關閉
  8.     Workbooks.Open (Xpath & "資料庫.xlsb")
  9.         For Each sh In Workbooks(W1).Sheets
  10.                 Workbooks("資料庫.xlsb").Sheets(sh.Name).UsedRange.Clear
  11.                 Workbooks(W1).Sheets(sh.Name).[a1].CurrentRegion.Copy
  12.                 Workbooks("資料庫.xlsb").Sheets(sh.Name).Activate'有點多餘的程式碼,但不太會改
  13.                 Range("a1").Select'我只是要讓下面貼到a1
  14.                 Workbooks("資料庫.xlsb").Sheets(sh.Name).Paste'直接貼上不會貼到[A1],因此多了上面兩行程式碼
  15.         Next
  16.     Workbooks("資料庫.xlsb").Close True
  17.     Workbooks.Open Xpath & "資料庫.xlsb", ReadOnly:=True  '再度開啟檔案(唯讀)
  18.     Application.WindowState = xlMinimized '將資料庫最小化
  19.     Application.CutCopyMode = xlCopy '清除剪貼簿
  20.     Application.ScreenUpdating = True
  21.     Application.DisplayAlerts = True
  22.     MsgBox "操作成功"
  23. End Sub
複製代碼
作者: GBKEE    時間: 2014-12-2 08:37

回復 7# PKKO

但以下兩行程式碼皆無反應
Sh(1).UsedRange.Clear
Sh(2).Copy Sh(1).Range("a1")
須更正為
  1. Sh(2).UsedRange.Copy Sh(1).Range("a1")
複製代碼
作者: PKKO    時間: 2014-12-2 14:11

回復 8# GBKEE


    原來如此,感恩!



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