Question

我想将值从范围S1:S6移动到范围T1删除重复项，并将它们从高到低排序。

我已经能够过滤数据并将其移动到所需的范围，但我无法弄清楚如何在目的地范围内对其进行排序。

继续使用移动和过滤数据的内容：

Range("S1:S6").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("T1"), Unique:=True

Filter Result

我可以用这条线对数据进行排序吗？

感谢您的时间，

Jonhdoe

Answer 1

对于此解决方案，高度建议单元格S1是标题而不是数据。至于在进行更改时进行过滤和排序，请使用Worksheet_Change事件。请务必将此代码放在图纸模块中，而不是标准模块中。要进入图纸模块，请双击Visual Basic编辑器左侧所需的图纸名称，这将打开该图纸的代码模块。

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rData As Range
    Dim rDest As Range

    'Adjust these as necessary
    Set rData = Me.Range("S1", Me.Cells(Me.Rows.Count, "S").End(xlUp))
    Set rDest = Me.Range("T1")

    'Disable events to prevent infinite loops
    Application.enableevents = False

    'Clear previous results
    rDest.EntireColumn.ClearContents

    'Make sure a change was made in column S
    If Not Intersect(rData, Target) Is Nothing Then
        'Change in column S found, make sure that there is more than 1 cell populated in column S
        If rData.Cells.Count > 1 Then
            'Extract unique values
            rData.AdvancedFilter xlFilterCopy, , rDest, True

            'Sort unique values high to low
            With Me.Range(rDest, Me.Cells(Me.Rows.Count, rDest.Column).End(xlUp))
                .Sort .Cells, xlDescending, Header:=xlYes
            End With
        End If
    End If

    'Re-enable events
    Application.enableevents = True

End Sub

排序并删除重复的VBA

1 个答案: