☰

Сохраняю работоспособность кода VBA, если запускаю его с помощью кнопки на другом листе, или заменяю код формулой

tag-icon • tag-icon microsoft-excel worksheet-function vba sorting
Сохраняю работоспособность кода VBA, если запускаю его с помощью кнопки на другом листе, или заменяю код формулой

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

Я также прикрепил снимок экрана, возможно, вместо этого кода VBA есть формула или можно сделать так, чтобы код VBA запускался без нажатия каких-либо кнопок. У меня нет Office 365, поэтому функция =FILTER не работает.

Sub SortCC()
'
' SortCC Macro
'

'
    Sheets("Jan_List").Select
    Range("K2:R4").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Selection.End(xlUp).Select
    Range("T2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    ActiveWorkbook.Worksheets("Jan_List").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Jan_List").Sort.SortFields.Add2 Key:=Range( _
        "T2:T1241"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Jan_List").Sort
        .SetRange Range("T2:AA1241")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

введите описание изображения здесь

Большое спасибо

решение1

Поместите этот код в обычный модуль -нетв Sheetили ThisWorkbook.
Добавьте кнопку к каждому листу, который вы хотите отсортировать, и подключите ее к макросу.

Public Sub SortCC()

    'You want the code to run on the sheet that has the button.
    'To manually push the button the correct sheet must be active.
    'So in this case we can use ActiveSheet.  Note this is the only Sheet reference in the code.
    With ActiveSheet
        'Assumes Column R (18) has a value in last row of data.
        Dim DataRange As Range
        Set DataRange = .Range("K2", .Cells(.Rows.Count, 18).End(xlUp))
        
        DataRange.Copy
        .Range("T2").PasteSpecial Paste:=xlPasteValues
        
        'We could figure out the new range the same way we did with the old one,
        'but seeing as it's the same size as the original and one column across
        'we can just use offset to figure it out.
        Dim NewDataRange As Range
        Set NewDataRange = DataRange.Offset(, DataRange.Columns.Count + 1)
    
        With .Sort
            .SortFields.Clear
            
            'Sorting on first column of NewDataRange so have resized it to one column.
            'For another column use, for example, .Offset(,1).Resize(,1) for second column.
            .SortFields.Add2 Key:=NewDataRange.Resize(, 1), _
                                  SortOn:=xlSortOnValues, _
                                  Order:=xlDescending, _
                                  DataOption:=xlSortNormal
            .SetRange NewDataRange
            .Header = xlNo
            .MatchCase = False
            .Orientation = xlTopToBottom
            .Apply
        End With
                              
    End With
    
End Sub

Связанный контент