Sub 筛选唯一值() '筛选唯一值 Dim Des As New Collection Dim Newsheet As Worksheet Dim Oldsheet As Worksheet Dim ItemX As Variant Dim Rg As Range Dim i As Integer Application.ScreenUpdating = False Application.DisplayAlerts = False On Error Resume Next For Each Rg In Selection If Rg <> "" Then Des.Add Rg.Value, CStr(Rg.Value) Next On Error GoTo 0 For Each Oldsheet In Worksheets If Oldsheet.Name = "FilterSheet" Then Oldsheet.Delete Next Set Newsheet = Worksheets.Add Newsheet.Name = "FilterSheet" i = 1 For Each ItemX In Des Newsheet.Cells(i, 1).Value = ItemX i = i + 1 Next Range("A1").Sort KEY1:=Columns("A") Application.ScreenUpdating = True Application.DisplayAlerts = False Set Des = Nothing Set Newsheet = Nothing Set Oldsheet = Nothing End Sub 简写一段代码,活用了一下Collection对象。