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

这里的问题：

我正在尝试创建一个Excel 2013宏来比较中的值一个工作簿上的列A（“活动工作簿”）到另一个工作簿的列A. 特定目录中的Excel文件。重复的值（行）会然后从活动工作簿中删除。

所以，让我们打破这个：

需要打开工作簿的目录。
当其中一个工作簿打开时，您希望检查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是为了最大限度地提高清晰度，而不是为了获得最佳速度（远离它！）。我在你的问题中看到你一直在研究比较变体/数组，这确实要快得多。

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

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

1 个答案: