前提：
這些作業薄都在同一個目錄
作業薄數量是 不確定的
所以 需要有一個腳本 ：
能夠自動的把當前目錄下的所有作業薄的同樣格式的表格的同一個位置相加，然后再另一個匯總表中統計。
例子（半成品）：
Sub HZ()
Application.ScreenUpdating = False
Range("A2:I65536").ClearContents
ARR = Range("A1:I500")
M = 1
Dirs = Dir(ThisWorkbook.Path & "\*.xls")
While Dirs <> ""
If Dirs <> ThisWorkbook.Name Then
myDatePath = ThisWorkbook.Path & "\" & Dirs
Set WB = GetObject(myDatePath)
BRR = WB.配置價格清單.UsedRange
A = BRR
Dirs = Dir
Wend
Application.ScreenUpdating = True
Range("A1").Resize(M, 9) = ARR
MsgBox "匯總完畢!"
End Sub
求解。
uj5u.com熱心網友回復：
同樣格式的表格 怎么判斷？uj5u.com熱心網友回復：
因為表都是同樣的呀，我直接COPY,COPY,再COPY的。。所以說，除了單元格里的數值不一樣，其他的都一樣。uj5u.com熱心網友回復：
請參考：Sub test()
On Error GoTo 100
Dim Wbk As Workbook, tWbk As Workbook
Application.ScreenUpdating = False
Dim bFile As String, iRow As Long
Set tWbk = ThisWorkbook
bFile = Dir(tWbk.Path & "\*.xls")
iRow = 1
While bFile <> ""
Set Wbk = Application.Workbooks.Open(tWbk.Path & "\" & bFile)
''將新打開的表格sheet1的a1:h1復制當前表格相應的位置
Wbk.Worksheets("sheet1").Range("a1:h1").Copy tWbk.Sheets("sheet2").Cells(iRow, 1)
Wbk.Close False ''關閉作業簿
iRow = iRow + 1
bFile = Dir
Wend
Set Wbk = Nothing
Set tWbk = Nothing
Application.ScreenUpdating = True
MsgBox "匯總完畢!"
Exit Sub
100:
MsgBox Err.Description
End Sub
uj5u.com熱心網友回復：
感謝 Topc008 您的回復，但是您貌似理解錯啦，是這樣的，您參考這個函式命令：SUMIF ='[XX1.xls]價格清單'!K12+'[XX2.xls]配置價格清單'!K12+....
意思就是把目錄里的所有的XX*.xls的作業薄中的表格中的同一個 單元格 統計起來，把結果輸入到 新的作業薄的某一個單元格中，如'[統計.xls]總統計'!B9。
結果就是：通過'[統計.xls]總統計'!B9 單元格，可以得到所有當前目錄下XX*xls作業薄中同表同單元格的數值和。
uj5u.com熱心網友回復：
下面的代碼進行求和統計，至于有沒有sheet1表格，自行添加判斷Sub test()
On Error GoTo 100
Dim bFile As String, tStr As String, bPath As String
bPath = ThisWorkbook.Path
''bPath = "d:\myset"
If Len(bPath) = 0 Then MsgBox "沒有目錄！": Exit Sub
If Right$(bPath, 1) <> "\" Then bPath = bPath & "\"
bFile = Dir(bPath & "*.xls")
tStr = ""
''累計每個檔案的sheet1表格的A1單元格。如果要統計其它單元格，自行修改
While bFile <> ""
If LCase$(ThisWorkbook.Name) <> LCase$(bFile) Then ''排除自身
tStr = tStr & IIf(tStr <> "", "+", "")
tStr = tStr & "'" & bPath & "[" & bFile & "]Sheet1'!$A$1"
End If
bFile = Dir
Wend
Sheet1.Range("a2").Formula = "=" & tStr
MsgBox "匯總完畢!"
Exit Sub
100:
MsgBox Err.Description
End Sub
轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/131246.html
標籤：VBA
上一篇：急急急，求大神們幫我解決VS2010 serialport 發送和接收漢字的問題！
下一篇：VB COM口資料監控