vba - 比较不同 excel 2013 文件中的列并从其中一个工作簿中删除重复项(需要宏)

Question

这是我在这个网站上的第一个问题，我不是程序员，所以请多多包涵。

我正在尝试创建一个 Excel 2013 宏，它将一个工作簿(“事件工作簿”)上 A 列中的值与特定目录中其他 Excel 文件的 A 列进行比较。然后将从事件工作簿中删除重复的值(行)。

因为我不是程序员，所以我一直在努力解决这个问题。到目前为止，当两列并排(相同的工作表)时，我已经能够使用条件格式来突出显示唯一值。我用了=ISNA(MATCH($A2,$B$2:$B$12,0)) .

然后我使用宏将重复值打印到另一列(而不是突出显示它们。我仍在这个阶段比较同一个工作表中的两列)。我通过使用以下宏来做到这一点:

Sub Find_Matches()
Dim CompareRange As Variant, x As Variant, y As Variant
' Set CompareRange equal to the range to which you will
' compare the selection.
Set CompareRange = Range("C1:C12")
' NOTE: If the compare range is located on another workbook
' or worksheet, use the following syntax.
' Set CompareRange = Workbooks("Book2"). _
'   Worksheets("Sheet2").Range("C1:C5")
'
' Loop through each cell in the selection and compare it to
' each cell in CompareRange.
For Each x In Selection
    For Each y In CompareRange
        If x = y Then x.Offset(0, 1) = x
    Next y
Next x
End Sub

然后我尝试从两个不同的工作表中删除重复值，但这不起作用:

Sub ProcessFiles()

Dim Filename, Pathname As String
Dim wb1 As Workbook
Dim wb2 As Workbook

Dim Sheet As Worksheet
Dim PasteStart As Range
Dim Counter As Integer

Set wb1 = ActiveWorkbook
Set PasteStart = [RRimport!A1]

Pathname = ActiveWorkbook.Path & "\For Macro to run\"
Filename = Dir(Pathname & "*.xls")
Do While Filename <> ""
    Set wb2 = Workbooks.Open(Pathname & Filename)
    For Each Sheet In wb2.Sheets
            With Sheet.UsedRange
            .Copy PasteStart
            Set PasteStart = PasteStart.Offset(.Rows.Count)
        End With
    Next Sheet
    wb2.Close
    Filename = Dir()
Loop
End Sub

我已经阅读这个网站几天了，还通过 YouTube 进行了搜索。在我做了前两件基本的事情之后，我并没有取得太大的成功。

项目背景:每天我们都有一个名为“待定列表”的列表，它基本上是我们需要完成的所有项目。这个列表每天都在增长。每个项目都有一个唯一标识符(数值)，列在事件工作簿的 A 列中。每天我都会为正在完成的项目创建自己的文件。我希望 Excel 能够删除重复项(即在我的待处理列表和其他文件中的项目，只留下唯一的，而不是通过每天比较几个文件来手动检查每个项目仍然需要完成的项目。希望我没有让任何人感到困惑，但如果我这样做了，请告诉我。

Answer 1

这里的问题:

I am trying to create an Excel 2013 macro that will compare values in column A on one workbook ("active workbook") to column A's of other Excel files in a particular directory. Duplicate values (rows) would then be deleted from the active workbook.

所以，让我们分解一下:

有一个需要从中打开工作簿的目录。

当其中一个工作簿打开时，您要检查 A 列(为了下面的示例，我假设这是在第一个工作表上)您在事件工作簿中 A 列中的值(将运行宏的那个) )。

如果存在匹配项，请从存储该值的事件工作簿中删除该行。

完成后，继续目录中的下一个工作簿。

第 1 点和第 4 点:从特定目录打开一些文件:

我们需要一些函数来打开和关闭文件。这个问题在 SO 上被问过很多次，例如 here

此外，我们需要将工作簿存储在某个变量中，我们将在下一步中将其传递给比较。

Public Sub LoopOverFiles()
'Our variables:
Dim wb1 As Workbook 'To hold the active workbook / the macro workbook
Dim wb2 As Workbook 'To hold the workbook we'll be comparing to later on
Dim scanFolder As String 'To set the folder in which the files will be located
Dim fileNameToOpen As String 'To get the filenames that we will open

Set wb1 = ThisWorkbook
scanFolder = "C:\temp\"
fileNameToOpen = Dir(scanFolder & "*.xlsx")

'And loop over the files:
Do While Len(fileNameToOpen) > 0 'To exit the loop when there's no more xlsx files
    Set wb2 = Workbooks.Open(scanFolder & fileNameToOpen)

    'To do the actual comparison of the 2 workbooks, we call our compare routine.
    DoTheComparison wb1, wb2 'Note we'll be passing the two workbooks as parameters to the compare function

    wb2.Close SaveChanges:=False 'We don't want to leave it open after we're done with it.
    fileNameToOpen = Dir 'To continue with the next file.
Loop
End Sub

第 2 点和第 3 点:进行比较并删除一些行

如您所见，实际比较将由一个名为 DoTheComparison 的例程完成。这需要 2 个工作簿作为参数。根据第一个例程，我们知道将传递的工作簿是正确的(wb1 是事件的，wb2 是在循环期间打开的变量)。
在此示例中，我们将坚持使用 wb2 中的第一个工作表。

Public Sub DoTheComparison(wb1 as Workbook, wb2 as Workbook)
'Dim compareFrom as Range - Not needed.
Dim compareTo as Range
Dim compareFromCell as Range
Dim compareToCell as Range

Dim i as Integer 
'EDIT: Since we delete, we need a backwards loop. This can't be done with "for each" so we'll use "for" with step -1. 
'That is why we also don't need the "CompareFrom" range variable anymore.

Set compareTo = wb2.Worksheets(1).Range("A2:A20")

For i = 20 to 2 step -1 
    Set compareFromCell = wb1.Worksheets("RemoveValsFromHere").Range("A" & i) 'We get the cells based on the index. 
    For Each compareToCell in compareTo

        If compareFromCell.Value = compareToCell.Value Then 'Point 3:
            compareFromCell.EntireRow.Delete shift:=xlUp
            Exit For 
            'Note that we need to exit the inner loop: 
            'After a match was found, the "compareFromCell" is deleted after all.
            'Therefore we have to continue with the next compareFromCell, otherwise we'll get an error.
        End If

    Next compareToCell
Next i
End Sub

请注意，尤其是 DoTheComparison是为了最大的清晰度而写的，而不是为了最佳的速度(远非如此!)。我在您的问题中看到您一直在研究比较变体/数组，这确实要快得多。

编辑:我更改了上面的代码，因为您因删除单元格而面临“跳过单元格”问题。简而言之:索引发生变化，因此在删除后移动到下一个单元格时，索引是错误的。修复是一个简单的向后 for 循环。另见 this question and answer