Excel文件簿中有多个子文件夹,其中有大量相同名称不同检测结果,需要把相同名称第一次检测结果提取合并

2025-01-25 09:17:10
推荐回答(1个)
回答1:

可采用如下代码。该文件尽量不要放在目标文件夹中。运行时,只运行该workbook,其余关闭。
其中的扩展名(xls还是xlsx需要你确认一下,可更改)
Sub Data_Col()
Dim my_Path As String
Application.FileDialog(msoFileDialogFolderPicker).Show
my_Path = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)
Dim my_Doc As String
my_Doc = Dir(my_Path & "\" & "*.xlsx") '手动更改扩展名
Dim j As Single
j = 1
Do While Len(my_Doc) <> 0
Workbooks.Open (my_Path & "\" & my_Doc)
ThisWorkbook.Worksheets(1).Cells(j,1)=my_doc
Dim i As Single
For i = 2 To 12
ThisWorkbook.Worksheets(1).Cells(j, i) = Workbooks(2).Worksheets("TEST -RESULT").Cells(29, i)
Next
Workbooks(2).Close
my_Doc = Dir
j = j + 1
Loop
End Sub