Question

我有一堆excel文件（大约1000个文件），我想将它们合并在一起并删除它们的重复行。我有以下excel vba宏来执行此操作。

    Sub simpleXlsMerger()
Dim bookList As Workbook
Dim counter As Integer
counter = 1
Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object
Application.ScreenUpdating = False
Set mergeObj = CreateObject("Scripting.FileSystemObject")

'change folder path of excel files here
Set dirObj = mergeObj.Getfolder("C:\Users\dalakada\Desktop\deneme google drive keywords 100 tane")
Set filesObj = dirObj.Files
For Each everyObj In filesObj
Set bookList = Workbooks.Open(everyObj)

'change "A2" with cell reference of start point for every files here
'for example "B3:IV" to merge all files start from columns B and rows 3
'If you're files using more than IV column, change it to the latest column
'Also change "A" column on "A65536" to the same column as start point
Range("A2:N" & Range("A1000000").End(xlUp).Row).Copy
ThisWorkbook.Worksheets(1).Activate

'Do not change the following column. It's not the same column as above
Range("A1000000").End(xlUp).Offset(1, 0).PasteSpecial
If counter Mod 90 = 0 Then
    Call RemoveDuplicatesCells_EntireRow
End If


Application.CutCopyMode = False
bookList.Close
counter = counter + 1
Next
End Sub

使用这个子程序，我只是基本打开指定文件夹中的每个文件并将它们合并到一个excel文件中。一切都在这里工作。

Sub RemoveDuplicatesCells_EntireRow()
'PURPOSE: Remove the entire row of duplicate cell values within a selected cell range
'SOURCE: www.TheSpreadsheetGuru.com

Dim rng As Range
Dim x As Integer

'Optimize code execution speed
  Application.ScreenUpdating = False

'Determine range to look at from user's selection
  On Error GoTo InvalidSelection
    Set rng = Range("B2:B1000000")
  On Error GoTo 0

'Ask user which column to look at when analyzing duplicates
  On Error GoTo InputCancel
    x = InputBox("Which column should I look at? (Number only!)", _
      "Select A Column", 1)
  On Error GoTo 0

'Optimize code execution speed
  Application.Calculation = xlCalculationManual

'Remove entire row if duplicate is found
  rng.EntireRow.RemoveDuplicates Columns:=x

'Change calculation setting to Automatic
  Application.Calculation = xlCalculationAutomatic

Exit Sub

'ERROR HANDLING
InvalidSelection:
  MsgBox "You selection is not valid", vbInformation
  Exit Sub

InputCancel:

End Sub

这是删除重复的行子。此代码也可以独立工作。问题是如果我将此代码与我编写的simpleXlsMerger代码结合使用。这是行不通的。它给了我空白工作表。你的想法是什么？非常感谢你。

删除重复行代码有什么问题？

0 个答案: