VBA Excel如何自动将多个文件与一个主文件进行比较，然后复制/粘贴结果

Question

https://postimg.org/image/laeyoj9wn/ =列表

https://postimg.org/image/ihlr4i9k7/ =主列表

我想比较List和Master列表序列号。如果序列号中存在相似性值，则序列号值将自动粘贴到第三列

Sub AutoUpdate()
Dim Dic As Object, key As Variant, oCell As Range, i&
Dim w1 As Worksheet, w2 As Worksheet

    Set Dic = CreateObject("Scripting.Dictionary")
    Set w1 = Workbooks("Book1.xlsm").Sheets("Sheet1")
    Set w2 = Workbooks.Open("C:\UsersSurvey Testing\Book2.xlsx").Sheets("Sheet1")
    Set w3 = Workbooks.Open("C:\Users\Survey Testing\Book3.xlsx").Sheets("Sheet1")


    i = w2.Cells.SpecialCells(xlCellTypeLastCell).Row
    For Each oCell In w2.Range("A2:A" & i)
        If Not Dic.exists(oCell.Value) Then
            Dic.Add oCell.Value, oCell.Offset(, 0).Value
        End If

    Next
    i = w3.Cells.SpecialCells(xlCellTypeLastCell).Row
    For Each oCell In w3.Range("A2:A" & i)
        If Not Dic.exists(oCell.Value) Then
            Dic.Add oCell.Value, oCell.Offset(, 0).Value
        End If


    Next
    i = w1.Cells.SpecialCells(xlCellTypeLastCell).Row
    For Each oCell In w1.Range("A2:A" & i)
        For Each key In Dic
            If oCell.Value = key Then
                oCell.Offset(, 2).Value = Dic(key)
        End If


        Next
    Next

End Sub

我不想在代码中逐个设置工作簿，而是想自动查找并设置文件夹中的所有工作簿并进行比较。因为可能需要比较很多工作簿。

Answer 1

从概念上讲，这可以在没有VBA的情况下完成，使用Power Query，Excel 2010和2013的免费Microsoft加载项，并作为Get和Transform内置到Excel 2013中。

打开文件夹中的所有文件，附加它们，删除重复项并保存为主文件。

添加新文件后，请刷新查询。

Answer 2

看看this question。从该代码中，您的代码如下所示：

Sub Compare()
Dim Dic As Object
Dim fso As Object 'FileSystemObject
Dim fldStart As Object 'Folder
Dim fl As Object 'File
Dim Mask As String, i As Long
Dim Wbk As Workbook

Set fso = New FileSystemObject
Set fld = fso.GetFolder("C:\UsersSurvey Testing")

Set Dic = CreateObject("Scripting.Dictionary")

Mask = "*.xlsx"

For Each fl in fld.Files
    If fl.Name Like Mask Then
        Set Wbk = Workbooks.Open(fld & "\" & fl.Name).Sheets("Sheet1")
        i = Wbk.Cells.SpecialCells(xlCellTypeLastCell).Row
        For Each oCell In Wbk.Range("A2:A" & i)
            If Not Dic.exists(oCell.Value) Then
                Dic.Add oCell.Value, oCell.Offset(, 0).Value
            End If
        Next oCell
    End If
Next fl
End Sub

注意：我没有测试过这段代码。这只是为了让您了解要尝试的内容。