Принудительно сортировать определенные данные при редактировании внизу, а не по алфавиту

Question

Я не могу заставить мои строки правильно сортировать, когда происходит изменение.

Я очень новичок в VBA и сам пытаюсь отработать свой код, но совершенно растерялся. Я работаю в Excel 2013.

Private Sub Worksheet_Change(ByVal Target As Range)

    On Error Resume Next

    If Not Intersect(Target, Range("D:D")) Is Nothing Then
        Range("D1").Sort Key1:=Range("D4"), _
          Order1:=xlAscending, Header:=xlYes, _
          OrderCustom:=1, MatchCase:=False, _
          Orientation:=xlTopToBottom
    End If

End Sub

Я получил этот код для работы, чтобы толкать строки в алфавитном порядке всякий раз, когда я изменяю значение (из выпадающего списка) в столбце D. В идеале, я хочу, чтобы мой код выдвигал все, что говорит "ЗАКРЫТО" в столбце D, в конец. По крайней мере, мне нужен этот код для сортировки этих строк в Z-A всякий раз, когда что-то в D изменяется.

Answer 1

Вы можете использовать пользовательский список сортировки (например, closed,*) и программно установить аргумент xlDescending, чтобы closed всегда заканчивался в нижней части списка. Однако это также отсортирует оставшиеся строки в порядке xlDescending. Это может или не может быть желательным.

Вариант 1: пользовательский порядок сортировки

В личном кодовом листе рабочего листа:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    If Not Intersect(Target, Range("D:D")) Is Nothing Then
        On Error GoTo end_safe
        Application.EnableEvents = False
        With Sort
            With .SortFields
                .Clear
                .Add2 Key:=Range(Cells(2, "D"), Cells(Rows.Count, "D").End(xlUp)), _
                      SortOn:=xlSortOnValues, Order:=xlDescending, _
                      CustomOrder:="closed,*", DataOption:=xlSortNormal
            End With
            .SetRange Intersect(Range("A:Z"), UsedRange)
            .Header = xlYes
            .Orientation = xlTopToBottom
            .Apply
        End With
    End If

end_safe:
    Application.EnableEvents = True

End Sub

Вы хотите, чтобы был закрыт внизу списка, поэтому одной из альтернатив может быть установка правила условного форматирования для изменения шрифта или фоновой заливки для closed , а затем использование этого DisplayFormat для сортировки по цвету с xlDescending. Это подтолкнет все закрытые к нижней части блока данных без изменения исходного порядка оставшихся (т. Е. незамкнутых ) строк.

Вариант 2: сортировка по условному форматированию DisplayFormat

В личном кодовом листе рабочего листа:

Option Explicit

'manually run this once to quickly add a CFR for 'closed' cells
Private Sub addClosedCFR()

    With Range("D:D")
        .FormatConditions.Delete
        With .FormatConditions.Add(Type:=xlExpression, Formula1:="=$D1=""closed""")
            .Font.Color = vbRed   'vbBlack
        End With
    End With

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

    If Not Intersect(Target, Range("D:D")) Is Nothing Then
        On Error GoTo end_safe
        Application.EnableEvents = False
        With Sort
            With .SortFields
                .Clear
                .Add(Range(Cells(2, "D"), Cells(Rows.Count, "D").End(xlUp)), _
                     SortOn:=xlSortOnFontColor, Order:=xlDescending, _
                     DataOption:=xlSortNormal).SortOnValue.Color = vbRed    'vbBlack
            End With
            .SetRange Intersect(Range("A:Z"), UsedRange)
            .Header = xlYes
            .Orientation = xlTopToBottom
            .Apply
        End With
    End If

end_safe:
    Application.EnableEvents = True

End Sub

Если вы не хотите, чтобы закрывался , отображая красный цвет в столбце D, измените цвет шрифта на более подходящий. Я оставил vbBlack в комментариях, который не совпадает с цветом шрифта xlAutomatic по умолчанию, поэтому он будет отображаться без изменений, но при этом будет разрешена операция сортировки.

Ваша операция сортировки почти наверняка внесет изменения в столбец D вместе с остальной частью блока данных, поэтому временное отключение событий не позволит Worksheet_Change попытаться запустить поверх себя.