需求 根据目录选择项目，同时可以选择多个，将文件夹中被选择的工作薄合并在“合并...

Jeffao

请各位大神帮忙处理一下，根据目录选择项目，同时可以选择多个，将文件夹中被选择的工作薄合并在“合并”sheet

此目录可自行增加项目，同时选中后也可以后续被合并。
非常感谢！

Jeffao

因为被选择的工作薄中数据可能会与其它被选择的工作薄重复，若是可以去重求和“quantity”列最好，不行的话，我后续用数据透视表处理。现在首要的需求就是请各位大神，帮忙将文件夹中被选择的工作薄合并到同一表格，非常感谢！急需，因小白工作最近需要处理大量的表格。

Jeffao

各位大神，帮帮小白处理一下，不胜感激！

Jeffao

根据excel 目录选项，选择同一文件夹里对应的工作薄，合并到同一表格。

ykcbf1100

附件供参考。。
说实在的，用复选框选择还不如直接多选文件来得简单直接。

ykcbf1100

参与一下。。。

1. Sub ykcbf()   '//2024.12.3   合并
   
2.     Application.ScreenUpdating = False
   
3.     Set fso = CreateObject("Scripting.FileSystemObject")
   
4.     Set d = CreateObject("Scripting.Dictionary")
   
5.     p = ThisWorkbook.Path & ""
   
6.     Set ws = ThisWorkbook
   
7.     With ws.Sheets("目录")
   
8.         r = .Cells(Rows.Count, 1).End(3).Row
   
9.         arr = .[a1].Resize(r, 3)
   
10.         For i = 1 To UBound(arr)
    
11.             If .Cells(i, 3).Value = True Then d(arr(i, 2)) = ""
    
12.         Next
    
13.     End With
    
14.     ReDim brr(1 To 10000, 1 To 100)
    
15.     For Each f In fso.GetFolder(p).Files
    
16.         If LCase$(f.Name) Like "*.xls*" Then
    
17.             fn = fso.GetBaseName(f)
    
18.             If d.exists(fn) Then
    
19.                 n = n + 1
    
20.                 Set wb = Workbooks.Open(f, 0)
    
21.                 With wb.Sheets(1)
    
22.                     arr = .UsedRange
    
23.                     wb.Close False
    
24.                 End With
    
25.                 For i = IIf(n = 1, 1, 2) To UBound(arr)
    
26.                     m = m + 1
    
27.                     For j = 1 To UBound(arr, 2)
    
28.                         brr(m, j) = arr(i, j)
    
29.                     Next
    
30.                 Next
    
31.             End If
    
32.         End If
    
33.     Next f
    
34.     With ws.Sheets("合并")
    
35.         .UsedRange.Clear
    
36.         .[a1].Resize(m, 3) = brr
    
37.     End With
    
38.     Application.ScreenUpdating = True
    
39.     MsgBox "OK！"
    
40. End Sub
    
41. 
    

复制代码

Jeffao

ykcbf1100 发表于 2024-12-3 11:24
参与一下。。。

非常感谢大神的协助！目前功能已经可用了。

Jeffao

ykcbf1100 发表于 2024-12-3 11:24
附件供参考。。
说实在的，用复选框选择还不如直接多选文件来得简单直接。

大神，帮忙再看看，我新增的项，复选框有重影。请指教一下怎样解决？

Jeffao

Jeffao 发表于 2024-12-3 13:45
大神，帮忙再看看，我新增的项，复选框有重影。请指教一下怎样解决？

这个我刚刚自己解决，谢谢！就不额外增加大神的工作和精力了。

Jeffao

ykcbf1100 发表于 2024-12-3 11:24
附件供参考。。
说实在的，用复选框选择还不如直接多选文件来得简单直接。

在那个地方修改多复制一列的内容？目前你帮忙做的是复制3列的内容，感谢！