感谢 Varocarbas,这比我最终使用的代码简单一些。我使用的代码如下,以防有人想看到另一个选项。谢谢您的帮助!
Dim r As Long, c As Long, n As Long, x As Long
Dim rData As Range
Application.ScreenUpdating = False
n = ActiveSheet.Cells(1, 1).CurrentRegion.Columns.Count + 1
ActiveSheet.Cells(1, n).Value = "TEMP"
For r = 2 To ActiveSheet.Cells(1, 1).CurrentRegion.Rows.Count
ActiveSheet.Cells(r, n).Value = r
Next r
Set rData = ActiveSheet.Cells(1, 1).CurrentRegion
With ActiveSheet.Sort
.SortFields.Clear
For c = 1 To n
.SortFields.Add Key:=rData.Cells(1, c).Resize(rData.Rows.Count - 1, 1)
Next c
.SetRange rData
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
With rData
For r = 2 To .Rows.Count
x = 0
For c = 1 To n
If .Cells(r, c).Value <> .Cells(r + 1, c).Value Then
x = x + 1
Exit For
End If
Next c
If x = 0 Then
.Cells(r, n).Value = True
.Cells(r + 1, n).Value = True
End If
Next r
End With
With ActiveSheet.Sort
.SortFields.Clear
.SortFields.Add Key:=rData.Cells(1, n).Resize(rData.Rows.Count - 1, 1)
.SetRange rData
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
On Error Resume Next
rData.Columns(n).SpecialCells(xlCellTypeConstants, xlLogical).EntireRow.Delete
On Error Goto 0
rData.Columns(n).EntireColumn.Delete
Application.ScreenUpdating = True