Question

我目前有一个VBA宏已经完成，但不完全是我需要的。

这是VBA：

Sub StripRowDupes()
    Do Until ActiveCell = ""
        Range(ActiveCell, ActiveCell.End(xlToRight)).Select
        For Each Cell In Selection
            If WorksheetFunction.CountIf(Selection, Cell) > 1 Then
                Cell.ClearContents
            Else
            End If
        Next Cell
        On Error Resume Next
        Selection.SpecialCells(xlCellTypeBlanks).Delete Shift:=xlToLeft
        ActiveCell.Range("A2").Select
    Loop
End Sub

示例工作表数据（狗和发货在每行中都是重复的）：

A   | B    |   C    |   D
dog | cat  |  goat  |  dog
car | ship |  plane |  ship

运行此宏后，它会从行中删除重复的第一个实例，结果如下所示：

A   | B     |   C
cat | goat  |  dog
car | plane |  ship

我需要的是删除重复项的最后一个实例，而不是第一个重复实例，以获得以下结果：

A   | B    |   C
dog | cat  |  goat
car | ship |  plane

在当前的VBA脚本中要更改什么才能获得所需的结果？

Answer 1

<强> UPD：

Sub StripRowDupes()
    Dim c As Range, rng As Range
    Dim lastcol As Long
    Dim i As Long
    Dim rngToDel As Range, temp As Range

    Application.ScreenUpdating = False

    Set c = ActiveCell

    Do Until c = ""
        lastcol = Cells(c.Row, Columns.Count).End(xlToLeft).Column
        Set rng = c.Resize(, lastcol - c.Column + 1)

        For i = lastcol To c.Column Step -1
            If WorksheetFunction.CountIf(rng, c.Offset(, i - 1)) > 1 Then c.Offset(, i - 1).ClearContents
        Next i

        On Error Resume Next
        Set temp = rng.SpecialCells(xlCellTypeBlanks)
        On Error GoTo 0

        If Not temp Is Nothing Then
            If rngToDel Is Nothing Then
                Set rngToDel = temp
            Else
                Set rngToDel = Union(rngToDel, temp)
            End If
        End If

        Set c = c.Offset(1)
        Set temp = Nothing
    Loop

    If Not rngToDel Is Nothing Then rngToDel.Delete Shift:=xlToLeft

    Application.ScreenUpdating = True
End Sub

查找并删除行中的重复单元格，而不是列

1 个答案: