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



这是我在此站点上的第一个问题,我不是程序员,所以请忍受我。

我正在尝试创建一个Excel 2013宏,该宏将在一个工作簿(" Active Workbook")上的A中的值与特定目录中其他Excel文件的A列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 2013宏,以比较 一个工作簿上的A列(" Active Workbook")到其他列的A列 在特定目录中符合文件。重复的值(行)将 然后从主动工作簿中删除。

所以,让我们分解一下:

  1. 有一个目录需要打开工作簿。
  2. 当其中一个工作簿打开时,您想检查A(我认为这是为了下面的示例)在Active Workbook中A中具有的值的A(我认为这是在第一个工作表上)运行宏)。
  3. 如果有匹配项,请从存储该值存储的活动工作簿中删除行。
  4. 完成后,继续使用目录中的下一个工作簿。

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

我们将需要一些功能才能打开和关闭文件。这个问题已经被问到了很多次,例如在这里

另外,我们将需要将工作簿存储在某个变量中,我们将在下一步中进行比较。

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,不是为了最佳速度(远离它!)。我在您的问题中看到您正在考虑比较变体/数组,这确实更快了。

编辑:我更改了上面的代码,因为您由于单元格删除而面临"跳过单元格"问题。简而言之:索引会发生变化,因此删除后移动到下一个单元时,索引是错误的。修复程序是一个容易的循环的倒退。另请参阅此问题和答案

最新更新