返回列表 上一主題 發帖

[發問] 如何讓A檔儲存在"X檔",讓"X檔"當作資料庫

PKKO
　暱稱: PKKO

高中生Rank: 3Rank: 3

帖子
549 
主題
152 
精華
0 
積分
691 
點名
0  
作業系統
WIN7 
軟體版本
OFFICE 2010 
閱讀權限
50 
性別
男 
註冊時間
2013-8-10 
最後登錄
2022-9-7 

論壇榮譽勳章論壇贊助勳章
1# 跳轉到 » 倒序看帖
打印
tT
發表於 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
收藏 分享
PKKO

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
2#
發表於 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
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

PKKO
　暱稱: PKKO

高中生Rank: 3Rank: 3

帖子
549 
主題
152 
精華
0 
積分
691 
點名
0  
作業系統
WIN7 
軟體版本
OFFICE 2010 
閱讀權限
50 
性別
男 
註冊時間
2013-8-10 
最後登錄
2022-9-7 

論壇榮譽勳章論壇贊助勳章
3#
發表於 2014-11-28 05:18 | 只看該作者
回復 2# GBKEE

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

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

何種方式在於A檔的1~10個分頁"覆蓋"X檔的相同名稱分頁會比較快呢~?
PKKO

TOP

joey0415
　暱稱: joey0415

中學生Rank: 2

帖子
361 
主題
57 
精華
0 
積分
426 
點名
0  
作業系統
win7 
軟體版本
2003,2010 
閱讀權限
20 
性別
男 
註冊時間
2010-5-13 
最後登錄
2022-12-8 
4#
發表於 2014-11-28 13:06 | 只看該作者
回復 3# PKKO

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

以前我也做類似的方法，之後慢慢成真的資料庫就沒有什麼問題

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
5#
發表於 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
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

PKKO
　暱稱: PKKO

高中生Rank: 3Rank: 3

帖子
549 
主題
152 
精華
0 
積分
691 
點名
0  
作業系統
WIN7 
軟體版本
OFFICE 2010 
閱讀權限
50 
性別
男 
註冊時間
2013-8-10 
最後登錄
2022-9-7 

論壇榮譽勳章論壇贊助勳章
6#
發表於 2014-12-2 05:05 | 只看該作者
回復 5# GBKEE


    感謝大大!待會就來試一下
PKKO

TOP

PKKO
　暱稱: PKKO

高中生Rank: 3Rank: 3

帖子
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上小弟實際的程式碼
  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
複製代碼
PKKO

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
8#
發表於 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")
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

PKKO
　暱稱: PKKO

高中生Rank: 3Rank: 3

帖子
549 
主題
152 
精華
0 
積分
691 
點名
0  
作業系統
WIN7 
軟體版本
OFFICE 2010 
閱讀權限
50 
性別
男 
註冊時間
2013-8-10 
最後登錄
2022-9-7 

論壇榮譽勳章論壇贊助勳章
9#
發表於 2014-12-2 14:11 | 只看該作者
回復 8# GBKEE


    原來如此,感恩!
PKKO

TOP

        靜思自在 : 欣賞別人就是莊嚴自己。
返回列表 上一主題