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

这是我在这个网站上的第一个问题,我不是程序员,请耐心等待。

我正在尝试创buildExcel 2013macros,将一个工作簿(“活动工作簿”)的A列中的值与特定目录中其他Excel文件的A列进行比较。 重复的值(行)将从活动工作簿中删除。

我一直在一块一块地试图弄清楚这一点,因为我不是程序员。 到目前为止,我已经能够使用条件格式来突出显示唯一值,当两列并排(相同的工作表)。 我用=ISNA(MATCH($A2,$B$2:$B$12,0))

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

 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 

我一直在阅读这个网站几天,也通过YouTubesearch。 在我做的前两个基本事情之后,我没有取得太多的成功。

项目背景:我们每天都有一个名为“挂起列表”的列表,这个列表实质上就是我们需要完成的所有项目。 每天这个名单增长。 每个项目都有一个唯一的标识符(数字值)列在活动工作簿的列A中。 我每天创build自己的项目正在完成的文件。 我不希望每天通过比较几个文件逐个手动检查每个项目,而是希望Excel能够删除重复项(这意味着我的待处理列表和其他文件中的项目都是一样的,只留下唯一的希望我没有混淆任何人,但如果我做了,请让我知道。

这里的问题是:

我正在尝试创buildExcel 2013macros,将一个工作簿(“活动工作簿”)的A列中的值与特定目录中其他Excel文件的A列进行比较。 重复的值(行)将从活动工作簿中删除。

那么,让我们来分析一下:

  1. 有一个工作簿需要打开的目录。
  2. 当其中一个工作簿处于打开状态时,您需要检查列A(我假设这是第一个工作表中的下面的示例)为您的活动工作簿(将运行macros)。
  3. 如果匹配,则从存储该值的活动工作簿中删除该行。
  4. 完成后,继续在目录中的下一个工作簿。

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

我们将需要一些function打开和closures文件。 这个问题在SO上已经被问过很多次了,比如这里

此外,我们将需要将工作簿存储在某个variables中,我们将在下一步中将这些variables传递给比较。

 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是在循环中打开的variables)。 在这个例子中,我们将坚持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是为了最大的清晰度而编写的,而不是最佳的速度(远离它!)。 我在你的问题中看到你正在研究比较变种/数组,这实际上要快得多。

编辑:我改变了上面的代码,因为你面临的细胞删除“跳过细胞”问题。 简而言之:索引改变,所以当删除后移动到下一个单元时,索引是错误的。 修复是一个简单的向后循环。 也看到这个问题和答案