Re: [算表] 多個Excel檔合併成為可查詢計算的資料庫(VBA)
請用以下程式，本程式會將你銷售的資料擺在sheet1，前面會幫你加日期，
你原來最後五行的資料會擺在 sheet2 ，這樣以後你就可以自由的寫
簡單的公式去計算月、季、年等彙整資料 ...，其他就自己加工囉
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, start2 As Integer
Dim dt As String
Dim first As Integer, i As Integer
'要處理的目錄
path = "C:\Documents and Settings\brave_liu.GSS_DOMAIN.000\桌面\Q1\"
Dim wb: Set wb = ThisWorkbook
obApp.DisplayAlerts = False
obApp.ScreenUpdating = False
obApp.EnableEvents = False
Dim myfiles: Set myfiles = myFso.GetFolder(path).Files
wb.Sheets(2).Cells(1, 1) = "總營業額"
wb.Sheets(2).Cells(1, 2) = "利潤"
wb.Sheets(2).Cells(1, 3) = "分攤費用"
wb.Sheets(2).Cells(1, 4) = "當天額外花費"
wb.Sheets(2).Cells(1, 5) = "扣除利潤後的金額"
For Each myfile In myfiles
If myfile.Name Like "*.xls" Then
Set wbnew = obApp.Workbooks.Open(path & myfile.Name)
dt = "20" & Left(myfile.Name, 2) & "/" & Mid(myfile.Name, 3, 2) _
& "/" & Mid(myfile.Name, 5, 2)
With wbnew.Worksheets(1)
first = 1
While Len(Trim(.Cells(first, 1))) > 0 _
And Not IsNumeric(Trim(.Cells(first, 1)))
first = first + 1
Wend
Start = wb.Sheets(1).Range("A1").CurrentRegion.Rows.count + 1
start2 = wb.Sheets(2).Range("A1").CurrentRegion.Rows.count + 1
rCount = .Cells.SpecialCells(xlCellTypeLastCell).Row
.Range(.Cells(1, 1), .Cells(first - 1, .Columns.count)).EntireRow.Copy
wb.Sheets(1).Paste Destination:=ActiveWorkbook.Sheets(1).Range("B" & Start)
For i = Start To Start + first - 2
wb.Sheets(1).Cells(i, 1) = dt
Next i
For i = 1 To 5
wb.Sheets(2).Cells(start2, 1) = dt
wb.Sheets(2).Cells(start2, i + 1) = .Cells(i + rCount - 5, 1)
Next i
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
--
※ 發信站: 批踢踢實業坊(ptt.cc)
◆ From: 61.229.82.204
推
05/21 01:40, , 1F
05/21 01:40, 1F
→
05/21 10:06, , 2F
05/21 10:06, 2F
推
05/21 13:17, , 3F
05/21 13:17, 3F
→
05/21 14:42, , 4F
05/21 14:42, 4F
推
05/23 00:13, , 5F
05/23 00:13, 5F
討論串 (同標題文章)
完整討論串 (本文為第 2 之 2 篇)：