6

Есть ли способ пересортировать автоматически? Я автоматически обновляю ячейки и в зависимости от входящих значений рейтинг меняется. Я ищу способ автоматического преобразования таблицы (аналогично условному форматированию) без необходимости нажатия кнопки повторной сортировки.

Цель здесь состоит в том, чтобы сделать это исключительно с помощью встроенной функции Excel2013. Я не ищу решение, которое включает в себя дополнительные ячейки, которые способствуют сортировке, такие как Rank(), ...

редактировать

Я включил код макроса, который обновляет книгу с заданным интервалом, а также включил код в один лист, который должен обновлять таблицы на этом листе в Worksheet_Calculate. Я получаю ошибку во время выполнения, не знаю, что не так?

Public RunWhen As Double
Const frequency = 5
Const cRunWhat = "DoIt"  ' the name of the procedure to run

Sub StartTimer()
    RunWhen = Now + TimeSerial(0, 0, frequency)
    Application.OnTime RunWhen, cRunWhat, Schedule:=True
End Sub

Sub DoIt()
    Sheets("RAWDATA").Calculate
    ActiveSheet.Calculate
    StartTimer  ' Reschedule the procedure
End Sub

Sub StopTimer()
    On Error Resume Next
    Application.OnTime RunWhen, cRunWhat, Schedule:=False
End Sub

и код, который якобы обновляет таблицы

Private Sub Worksheet_Calculate()

With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .DisplayAlerts = False
End With

ActiveSheet.ListObjects("Table2").AutoFilter.ApplyFilter
    With ActiveWorkbook.Worksheets("Strategies").ListObjects("Table2").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

ActiveSheet.ListObjects("Table3").AutoFilter.ApplyFilter
    With ActiveWorkbook.Worksheets("Strategies").ListObjects("Table3").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .DisplayAlerts = True
End With

End Sub

1 ответ1

3

Я не люблю оставлять вопросы без ответа, когда на них уже ответили, он комментирует. Вы можете прочитать историю в комментариях, но вот окончательное решение:

Private Sub Worksheet_Calculate()
    'If the active sheet is called "Strategies", then this reapplies the filter for two tables and re-sorts them

    Const wsName As String = "Strategies"

    If ActiveSheet.Name = wsName Then

        'Freeze everything and turn off events
        With Application
            .ScreenUpdating = False
            .EnableEvents = False
            .DisplayAlerts = False
        End With

        'Update Table2
        With Worksheets(wsName).ListObjects("Table2")
            .AutoFilter.ApplyFilter
            With .Sort
                .Header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With
        End With

        'Update Table3
        With Worksheets(wsName).ListObjects("Table3")
            .AutoFilter.ApplyFilter
            With .Sort
                .Header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With
        End With

        'Unfreeze things and turn events back on
        With Application
            .ScreenUpdating = True
            .EnableEvents = True
            .DisplayAlerts = True
        End With

    End If
End Sub

Вы могли бы даже сократить фильтрацию и сортировку просто

    With Worksheets(wsName).ListObjects("Table2")
        .AutoFilter.ApplyFilter
        .Sort.Apply
    End With

Это вики сообщества, потому что я не нашел решение. Вы можете отредактировать его, если хотите, но все, что я сделал, это расшифровал проблему, обнаруженную в комментариях, и немного очистил код.

Всё ещё ищете ответ? Посмотрите другие вопросы с метками .