1樓：江蘺
Sub資料彙總
()Dim
thisPath
AsString
DimwbName
AsString
Dimwb
AsObject
DimwbSheet
AsWorksheet
'把需要合併的工作簿放在乙個資料夾下面
thisPath
="檔案路徑"
DimlastRow
AsInteger
,lastCol
AsInteger
,lastCell
AsString
wbName
=Dir
(thisPath
&"*.csv"
)'獲取檔案資料，複製資料到總表
DoWhile
wbName
<>""Setwb=
GetObject
(thisPath
&wbName
)wbSheet=wb
.Worksheets(1
)With
wbSheet
'獲取當前工作簿活動單元格範圍
lastRow=.
Range
("A65536"
).End
(xlUp
).Row
lastCol=.
Range
("DD"
&lastRow
).End
(xlToLeft
).Column
lastCell=.
Range
("DD"
&lastRow
).End
(xlToLeft
).Address
'複製資料到總表
Range
("A"
&Range
("A1048576"
).End
(xlUp
).Row+1
).Resize
(lastRow-1
,lastCol
).Value=.
Range
("A2:"
&lastCell
).Value
EndWith
'關閉工作簿wb.
Close
False
wbName
=Dir
Loop
EndSub
使用getobject函式可以實現你想要的功能
2樓：吳棋仁
用ADO
Public
SubGetData
(SourceFile
AsVariant
,SourceSheet
AsString
,SourceRange
AsString
,TargetRange
AsRange
,Header
AsBoolean
,UseHeaderRow
AsBoolean
)' 30-Dec-2007, working in Excel 2000-2007
DimrsCon
AsObject
DimrsData
AsObject
DimszConnect
AsString
DimszSQL
AsString
DimlCount
AsLong
' Create the connection string.
IfHeader
=False
Then
IfVal(.
Version
)<12Then
szConnect
="Provider=Microsoft.Jet.OLEDB.4.0;"
&"Data Source="
&SourceFile
&";"
&"Extended Properties=""Excel 8.0;HDR=No"";"
Else
szConnect
="Provider=Microsoft.ACE.OLEDB.12.0;"
&"Data Source="
&SourceFile
&";"
&"Extended Properties=""Excel 12.0;HDR=No"";"
EndIf
Else
IfVal(.
Version
)<12Then
szConnect
="Provider=Microsoft.Jet.OLEDB.4.0;"
&"Data Source="
&SourceFile
&";"
&"Extended Properties=""Excel 8.0;HDR=Yes"";"
Else
szConnect
="Provider=Microsoft.ACE.OLEDB.12.0;"
&"Data Source="
&SourceFile
&";"
&"Extended Properties=""Excel 12.0;HDR=Yes"";"
EndIf
EndIf
IfSourceSheet=""
Then
' workbook level name
szSQL
="SELECT * FROM "
&SourceRange$&
";"Else
' worksheet level name or range
szSQL
="SELECT * FROM ["
&SourceSheet$&
"$"&
SourceRange$&
"];"
EndIf
OnError
GoTo
SomethingWrong
SetrsCon
=CreateObject
("ADODB.Connection"
)Set
rsData
=CreateObject
("ADODB.Recordset"
)rsCon
.Open
szConnect
rsData
.Open
szSQL
,rsCon,0
,1,1
' Check to make sure we received data and copy the data
IfNot
rsData
.EOF
Then
IfHeader
=False
Then
TargetRange
.Cells(1
,1).CopyFromRecordset
rsData
Else
'Add the header cell in each column if the last argument is True
IfUseHeaderRow
Then
ForlCount=0
TorsData
.Fields
.Count-1
TargetRange
.Cells(1
,1+lCount
).Value
=rsData
.Fields
(lCount
).Name
Next
lCount
TargetRange
.Cells(2
,1).CopyFromRecordset
rsData
Else
TargetRange
.Cells(1
,1).CopyFromRecordset
rsData
EndIf
EndIf
Else
MsgBox
"No records returned from : "
&SourceFile
,vbCritical
EndIf
' Clean up our Recordset object.
rsData
.Close
SetrsData
=Nothing
rsCon
.Close
SetrsCon
=Nothing
Exit
SubSomethingWrong
:MsgBox
"The file name, Sheet name or Range is invalid of : "
&SourceFile
,vbExclamation
,"Error"
OnError
GoTo
0EndSub
3樓：JimYoung
新建乙個新的excel檔案，用VBA
首先遍歷資料夾下的所有excel檔案，然後直接通過vba填充公式，Excel公式可以不開啟檔案而直接獲取裡面的任意單元格的任意資訊。
這就是思路。
4樓：yunke
基本步驟思路：
1、將要呼叫的工作薄統一放在乙個資料夾裡，假設該資料夾名稱為「資料」
2、將彙總工作簿與「資料」資料夾放在同一目錄裡
3、將「資料」資料夾內的所有Excel檔案的檔名提取到彙總工作簿的A列（見Sub提取資料夾內檔名()）
4、開始批量迴圈提取每乙個excel檔案指定資料（見Sub批量提取() 和 Sub 取值()）
Sub提取資料夾內檔名
()Dim
myPath
Dimn
AsInteger
DimmyFile
AsString
myPath
=ThisWorkbook
.Path
&"\資料"
'把檔案路徑定義給變數n=
2myFile
=Dir
(myPath
&"\*.*")Do
While
myFile
<>""Cells(n
,1)=
myFile
'從A2開始存放檔名
myFile
=Dir
'找尋下乙個檔案n=
n+1Loop
EndSub
Sub批量提取
()'呼叫Sub 取值
'假設你每次都是從「2016」工作表的 "C2:I2" 區域中複製資料到彙總表
取值ThisWorkbook
.Path
&"\資料"
,"2016"
,"C2:I2"
EndSub
Sub取值(路徑
AsString
,工作表
AsString
,單元格
AsString
)Dim
rngAs
Range
Dimnfile
AsString
Dimi
AsInteger
Fori=2
To42
' 假設你的excel檔案的數量有41個，存放到A42了
nfile
=Cells(i
,1)Set
rng=
Cells(i
,3).Resize
(Range
(單元格
).Rows
.Count
,Range
(單元格
).Columns
.Count
)With
rng.
FormulaArray
="='"&路徑
&"\["
&nfile
&"]"
&工作表
&"'!"
&單元格
.Value=.
Value
EndWith
Next
iEndSub
Eminem能不能在電視上說nigger？
stan 不能，但是你可以去b站上看他2001年在洛杉磯和dr dre的那場演唱會，還有xzibit三個人唱的 bit ch please2，在副歌那塊唱嗨了，我清清楚楚的聽到他說這個詞了哈哈哈 副歌原本是nate dogg唱的，所以有這個詞 山德士的炸雞 他不會說出黑鬼這個詞，他的師傅Dr.Dre...
電腦能不能在真空環境下執行？
我看見映紅的天 材料學1.散熱不是大問題，水冷即可。我這裡的水冷是蒸發式，將液態水分批次排入真空。在真空，電腦的溫度會使之迅速沸騰，同時吸收大量熱。這類似於高原水的沸點會降低至90 2.最大的問題是非固態的又無包裹元件的沸騰，和固態元件的昇華。我猜電腦應該沒有裸露的液態元件 不是學電子工程的。但是可...
孩子能不能在家裡玩輪滑鞋？
盧公尺和大紳士 家裡的家具比較多，容易磕磕碰碰，如果一定要在家裡玩，注意準備出一塊盡量大的空地，最好要有可以扶著的地方。不然就還是穿好護具去室外玩吧。 深海 球王貝利小時候在胡同裡踢自製的足球。如果你孩子特別的痴迷輪滑，沒有條件去場地練習，且他會自己想辦法為自己創造條件的話，就睜乙隻眼閉乙隻眼吧，盡...