Re: [算表] 多個Excel檔合併成為可查詢計算的資料庫(VBA)

看板Office作者windknife18 (windknife18)時間16年前 (2009/05/18 12:12)推噓8(8推 0噓 12→)

留言20則, 4人參與討論串1/2 (看更多)

以下程式是將某目錄下所有 excel 檔合併在目前excel檔的程式 VBA 的方法請參考精華區或之前的文章只要建立一個空白的excel檔，將VBA放入，然後執行即可！記得目錄要自己改成你要的，還有這個程式只做同一目錄下的檔案，並沒有針對子目錄作處理！ Option Explicit Sub Macro1() Dim path As String Dim obApp As New Excel.Application Dim myFso: Set myFso = CreateObject("Scripting.FileSystemObject") Dim wbnew, myfile Dim Start As Integer, rCount As Integer '要處理的目錄 path = "C:\Documents and Settings\Administrator\桌面\tt\" Dim wb: Set wb = ThisWorkbook obApp.DisplayAlerts = False obApp.ScreenUpdating = False obApp.EnableEvents = False Dim myfiles: Set myfiles = myFso.GetFolder(path).Files For Each myfile In myfiles If myfile.Name Like "*.xls" Then Set wbnew = obApp.Workbooks.Open(path & myfile.Name) With wbnew.Worksheets(1) Start = wb.Sheets(1).Range("A1").CurrentRegion.Rows.count + 1 rCount = .Cells.SpecialCells(xlCellTypeLastCell).Row .Range(.Cells(1, 1), .Cells(rCount, .Columns.count)).EntireRow.Copy wb.Sheets(1).Paste Destination:=ActiveWorkbook.Sheets(1).Range("A" & Start) End With wbnew.Close Set wbnew = Nothing End If Next obApp.EnableEvents = True obApp.ScreenUpdating = True obApp.DisplayAlerts = True Set obApp = Nothing MsgBox ("完成!") End Sub ※ 引述《acatz (無敵爆爆貓)》之銘言： : 軟體:M$ Excel : 版本:2003 SP3 : 本身都用手機在結算當日營業額，每天就用一個檔案來分開。 : 現在想要把這些資料結合成資料庫以利往後查詢、計算、平均，或者每個儲存格的最高、 : 加總、最低與平均。請問這是要結合Access嗎？還是Excel本身就可以這樣做了？如果要結 : 合的話，請問該怎作？市面上是否有書籍可以推薦？ : 還是這是要另外買商業軟體才能做到的呢？ -- ※ 發信站: 批踢踢實業坊(ptt.cc) ◆ From: 140.131.84.79 ※ 編輯: windknife18 來自: 140.131.84.79 (05/18 12:14)

推

wengho

05/18 12:18, , 1^F

05/18 12:18, 1^F

→

windknife18

05/18 16:40, , 2^F

05/18 16:40, 2^F

推

acatz

05/19 16:07, , 3^F

05/19 16:07, 3^F