當前位置:成語大全網 - 新華字典 - excel vba如何將其他許多excel文件中的其中壹條數據放到壹個excel表格中

excel vba如何將其他許多excel文件中的其中壹條數據放到壹個excel表格中

如果其他的Excel文件都在同壹個目錄中,

加個模塊,復制下面的代碼:

'****************************************************************

'功能:查找指定文件夾含子文件夾內所有文件名(含路徑)

'函數名:?FileAllArr

'參數1:Filename需查找的文件夾名?不含最後的"\"

'參數2:FileFilter?需要過濾的文件名,可省略,默認為:[*.*]

'參數3:Liwai剔除例外的文件名,可省略,默認為:空,壹般為:ThisWorkbook.Name

'返回值:?壹個字符型的數組

'使用方法:arr?=?FileAllArr(ThisWorkbook.Path,?"*.xls",?ThisWorkbook.Name)

Public?Function?FileAllArr(ByVal?Filename?As?String,?Optional?ByVal?FileFilter?As?String?=?"*.*",?Optional?ByVal?Liwai?As?String?=?"")?As?String()

Set?Dic?=?CreateObject("Scripting.Dictionary")'創建壹個字典對象

Set?Did?=?CreateObject("Scripting.Dictionary")

Dic.Add?(Filename?&?"\"),?""

i?=?0

Do?While?i?<?Dic.Count

Ke?=?Dic.keys'開始遍歷字典

MyName?=?Dir(Ke(i),?vbDirectory)'查找目錄

Do?While?MyName?<>?""

If?MyName?<>?"."?And?MyName?<>?".."?Then

If?(GetAttr(Ke(i)?&?MyName)?And?vbDirectory)?=?vbDirectory?Then'如果是次級目錄

Dic.Add?(Ke(i)?&?MyName?&?"\"),?""?'就往字典中添加這個次級目錄名作為壹個條目

End?If

End?If

MyName?=?Dir'繼續遍歷尋找

Loop

i?=?i?+?1

Loop

i?=?0

Dim?arrx()?As?String

For?Each?Ke?In?Dic.keys?'以查找總表所在文件夾下所有excel文件為例

MyFileName?=?Dir(Ke?&?FileFilter)?'過濾器:EXCEL2003為:*.xls,excel2007為:*.xlsx

Do?While?MyFileName?<>?""

If?MyFileName?<>?Liwai?Then?'排除例外文件

ReDim?Preserve?arrx(i)

arrx(i)?=?Ke?&?MyFileName

i?=?i?+?1

End?If

MyFileName?=?Dir

Loop

Next

FileAllArr?=?arrx

End?Function

'****************************************************************

可以在 Sheet1的代碼中寫

Sub?OPIONA()?'//函數實例

Dim?sP?As?String,?WB?As?Workbook

sP?=?"E:\VB合並同規格Excel\tmp"?'很多Excel文件的路徑,不含最後的\

arr?=?FileAllArr(sP,?"*.xls",?ThisWorkbook.Name)

Application.ScreenUpdating?=?False

For?i?=?0?To?UBound(arr)

'MsgBox?arr(I)

Set?WB?=?Workbooks.Open(arr(i))

'妳的代碼

ThisWorkbook.Worksheets(1).Cells(i?+?1,?1).Value?=?WB.Worksheets(1).Range("T1000").End(xlUp).Value

WB.Windows(1).Visible?=?False

WB.Close?False

Next

Application.ScreenUpdating?=?True

End?Sub

以上文件路徑需要自己更改,主要取數的代碼解釋如下:

ThisWorkbook.Worksheets(1).Cells(i + 1, 1).Value = WB.Worksheets(1).Range("T1000").End(xlUp).Value

從打開文件的T列最後壹個數值取值 ? 賦值給操作表的Sheet1中的單元格。

如果數據在每壹個Excel中的位置是固定的,比如T10,代碼可以直接改為:

ThisWorkbook.Worksheets(1).Cells(i + 1, 1).Value = WB.Worksheets(1).Range("T10").Value