提取多个表格中的数据并去重

小女孩

文件夹内有很多表格，如何把所有表格中的指定内容提取出来，去重，详见附件，谢谢给我老师帮我弄一下！ 求助.rar (75.53 KB, 下载次数: 26)

2025-6-10 19:27 上传

点击文件名下载附件

quqiyuan

参与一下，仅供参考。。。

quqiyuan

代码如下。。。
Sub test()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    t = Timer
    Dim wb As Workbook, sht As Worksheet, sh As Worksheet
    Set wb = ThisWorkbook
    p = wb.Path & "\"                                          '固定文件夹位置
    f = Dir(p & "*.xls*")
    Set sht = wb.Sheets("sheet1")
    Set d = CreateObject("scripting.dictionary")
    Do While f <> ""
        With Workbooks.Open(p & f, 0).Sheets(1)
            If f <> wb.Name Then
                arr = .[a1].CurrentRegion
                For i = 2 To UBound(arr)
                    For Each j In [{2,6,10}]
                        If arr(i, j) <> Empty Then d(arr(i, j)) = ""
                    Next
                Next
                .Parent.Close 0
            End If
        End With
        f = Dir
    Loop
    With sht
        sht.UsedRange.ClearContents
        If d.Count > 0 Then
            .[a1].Resize(d.Count) = Application.Transpose(d.keys)
            .[a1].Sort key1:=.[a1], Header:=xlNo
            .[a1].CurrentRegion.HorizontalAlignment = xlCenter
        End If
    End With
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    MsgBox "共耗时：" & Format(Timer - t, "0.0000") & " 秒！！！", 64
End Sub
   
   

今铭昔

朝露孤烟

学习字典的去重方法，供参考。

小女孩

十分感谢各位老师的帮助！