删除重复时 Headers

Question

使用下面的代码将重复的 headers 从合并为一个 excel 中删除，但出现错误。

  Application.Goto DestSh.Cells(1)

   ' AutoFit the column width in the summary sheet.
   DestSh.Columns.AutoFit

   With Application
       .ScreenUpdating = True
       .EnableEvents = True
   End With
   
   Dim xWs As Worksheet
   Application.ScreenUpdating = False
   Application.DisplayAlerts = False
   For Each xWs In Application.ActiveWorkbook.Worksheets
       If xWs.Name <> "Combined Sheet" Then
           xWs.Delete
       End If
   Next
   Application.DisplayAlerts = True
   Application.ScreenUpdating = True
   
   Dim lstRow As Integer, ws As Worksheet
       Set ws = ThisWorkbook.Sheets("Combined Sheet")
       With ws
       lstRow = .Cells(rows.Count, "B").End(xlUp).Row ' Or "C" or "A" depends

       .Range("A1:E" & lstRow).SpecialCells(xlCellTypeBlanks).EntireRow.Delete   ERROR GETTING HERE

   End With

enter image description here

Answer 1

请在使用 SpecialCells 方法前和使用“on error GoTo 0”后添加“on error resume next”

Answer 2

    .SpecialCells(xlCellTypeBlanks)

此表达式为您提供范围内的每个空白单元格。您要删除的行还包括 non-blank 个单元格，因此 vba 不会删除它们。您可以尝试 RemoveDuplicates 方法，例如：

    .Range("A1:E" & lstRow).RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5), Header :=xlNo

使用该方法可能不安全，但对于您的任务来说可能没问题。

此子是删除您的 header 的安全变体。您可以通过 Call 语句调用 sub，并且不要忘记设置您的 header 地址。

    Call removeHeaders()

    Sub removeHeaders()
    Dim hdrRangeAdr As String
    Dim l, frstRow, lstRow, offsetRow As Long
    Dim counter, row1, row2 As Integer
    Dim item As Variant
    Dim hdrRng, tRng As Range
    Dim ws As Worksheet
        
        ' setting of the first header address
        hdrRangeAdr = "A1:O1"
        Set ws = ThisWorkbook.Sheets("Combined Sheet")
        ' setting of the header range
        Set hdrRng = ws.Range(hdrRangeAdr)
        hdrRowsQty = hdrRng.Rows.Count
        frstRow = hdrRng.Row
        lstRow = hdrRng.Parent.UsedRange.Rows.Count + frstRow
        
        'checking row by row
        For l = 1 To lstRow - frstRow
            offsetRow = l + hdrRowsQty - 1
            counter = 0
            ' compare row/rows value with the header
            For Each item In hdrRng.Cells
                If item = item.Offset(offsetRow, 0) Then
                    counter = counter + 1
                End If
            Next
            
            ' if they are equial then delete rows
            If counter = hdrRng.Count Then
                row1 = frstRow + offsetRow
                row2 = row1 + hdrRowsQty - 1
                ws.Rows(row1 & ":" & row2).Delete Shift:=xlUp
                'reseting values as rows qty reduced
                l = 1
                lstRow = hdrRng.Parent.UsedRange.Rows.Count + frstRow
            End If
        Next
        
        Set ws = Nothing
        Set hdrRng = Nothing
        
    End Sub

祝你好运

删除重复时 Headers

While Deleting Repeated Headers

excel

vba