Excel VBA删除指定区域重复单元格异常问题排查（保留首个重复项）

Let's walk through the issues in your current code and fix it to meet your requirement: remove duplicate cells (retaining the topmost first occurrence) while ignoring column A, even if columns after B are empty.

Key Issues in Your Original Code #

• Conflicting Loop Controls: You're using both a Do While loop for Duplikat_row and an inner For loop for Sucher_row, which causes inconsistent traversal of rows. This leads to missing or over-processing rows.
• Incorrect Duplicate Check Logic: Your code deletes any matching value it finds immediately, regardless of whether it's an earlier (should be kept) or later (should be deleted) occurrence. It doesn't track which values have already been seen.
• Poor Index Management After Deletion: When you delete a cell and shift left, you adjust Sucher_column but the outer loop logic doesn't account for how this changes the remaining columns in the row.
• Undeclared Variables: Variables like testwert, duplikat, Sucher_rowTotalRows, etc., aren't declared, which can lead to unexpected behavior (always use Option Explicit to catch this!).

Corrected VBA Code #

Option Explicit

Sub RemoveDuplicateCells()
    Dim reportSheet As Worksheet
    Dim lastRow As Long
    Dim lastCol As Long
    Dim currentRow As Long
    Dim currentCol As Long
    Dim seenValues As Collection ' Tracks values we've already encountered (keep first occurrence)
    
    ' Set the target worksheet
    Set reportSheet = ThisWorkbook.Worksheets("Tabelle44")
    Set seenValues = New Collection
    
    ' Get the last used row (only column A counts per your requirement)
    lastRow = reportSheet.Cells(reportSheet.Rows.Count, "A").End(xlUp).Row
    
    ' Traverse rows from top to bottom (to keep topmost duplicates)
    For currentRow = 1 To lastRow
        ' Get the last used column in current row (skip column A)
        lastCol = reportSheet.Cells(currentRow, reportSheet.Columns.Count).End(xlToLeft).Column
        
        ' If only column A has content, skip to next row
        If lastCol < 2 Then
            Continue For
        End If
        
        ' Traverse columns from left to right (starting at B)
        currentCol = 2
        Do While currentCol <= lastCol
            Dim cellValue As Variant
            cellValue = reportSheet.Cells(currentRow, currentCol).Value
            
            ' Skip empty cells
            If IsEmpty(cellValue) Then
                currentCol = currentCol + 1
                Continue Do
            End If
            
            On Error Resume Next ' Ignore error if value already exists in collection
            seenValues.Add cellValue, Key:=CStr(cellValue)
            On Error GoTo 0
            
            ' If the value was already in the collection, delete this cell
            If Err.Number = 457 Then ' Error code for duplicate key
                reportSheet.Cells(currentRow, currentCol).Delete Shift:=xlToLeft
                lastCol = lastCol - 1 ' Update last column since we shifted left
                ' Don't increment currentCol - the next cell moved into this position
            Else
                currentCol = currentCol + 1 ' Move to next column
            End If
        Loop
    Next currentRow
End Sub

How This Code Works #

1. Option Explicit: Forces variable declaration, preventing typos and undeclared variable bugs.
2. seenValues Collection: Tracks every unique value we encounter starting from the top-left (column B, row 1). The key ensures we only keep the first occurrence.
3. Top-to-Bottom, Left-to-Right Traversal: We process rows starting from the top so the first occurrence of any value is retained. Columns are processed left to right to handle shifts correctly.
4. Empty Cell Handling: Skips empty cells since you mentioned columns after B might be empty.
5. Proper Index Adjustment: When a cell is deleted and shifted left, we decrement lastCol and don't increment currentCol – this lets us check the new cell that moved into the current column position.

Testing with Your Example #

For your original table:

1. ABCDE
2. a
3. bbcde
4. cbcef
5. ddefgh

Running the code will produce your desired result:

1. ABCDE
2. a
3. bbcde
4. cf
5. dgh

内容的提问来源于stack exchange，提问作者Horenz