Сортировка выбора не работает должным образом в Excel - PullRequest
0 голосов
/ 21 сентября 2019

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

Я просто пытался разными способами приблизиться к ней: с помощью записи макроса, самостоятельно, поиск в Google и документирование любым возможным способом.

Ввод: любой выбор, возможный на одном листе Excel с заголовками.

Ожидаемый результат: сортировка выбора по алфавиту.

Пробная версия 1: Запись макроса

Option Explicit  

Sub Macro1()

    ActiveWorkbook.Worksheets("Raw Data").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Raw Data").Sort.SortFields.Add Key:=Range( _
        "IV71"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Raw Data").Sort
        .SetRange Range("IV72:IZ78")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Этот код работает, но, очевидно, мне нужно настроить его для выбора:

Option Explicit  

Sub Macro1()
Dim MyRange as Range
Set MyRange = Selection

    ActiveWorkbook.Worksheets("Raw Data").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Raw Data").Sort.SortFields.Add Key:=MyRange,  _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Raw Data").Sort
        .SetRange MyRange 
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

На этом я получил ошибку 1004. Применить.Поэтому я изменил на:

Option Explicit  

Sub Macro1()
Dim MyRange as Range
Set MyRange = Selection

    ActiveWorkbook.Worksheets("Raw Data").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Raw Data").Sort.SortFields.Add Key:=MyRange,  _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Raw Data").Sort
        .SetRange MyRange 
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
    End With
    ActiveWorkbook.Worksheets("Raw Data").Sort.Apply
End Sub

Тот же результат: я получил ошибку 1004. Применить

Затем я удаляю объявление диапазона:

Option Explicit  

Sub Macro1()

    ActiveWorkbook.Worksheets("Raw Data").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Raw Data").Sort.SortFields.Add Key:=Selection,  _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Raw Data").Sort
        .SetRange Selection 
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
    End With
    ActiveWorkbook.Worksheets("Raw Data").Sort.Apply
End Sub

Это становитсястранно ... какие бы опции я ни проверял, он сообщает об ошибке 1004, он напрямую не работает или сообщает, что определенный раздел не может быть пустым (если это не так). Идея 1 Идея 2 Идея 3 Идея 4 Идея 5 Идея 6 Проверка 1 Проверка 2 Проверка 3 Проверка 4

Единственное, что меня беспокоит, если, может быть, поскольку Selection является объектом,возможно, установка его в качестве диапазона не удалась.

Еще одна деталь ... Эта процедура работает только тогда, когда я выбираю один столбец ... проблема в том, что я выбираю 2 или больше.

Кто-нибудь может мне помочь?

1 Ответ

0 голосов
/ 21 сентября 2019

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

Option Explicit  

Sub Macro1()

Dim MyRange As Range
Dim FirstCol As Long
Dim LastCol As Long
Dim FirstRow As Long
Dim LastRow As Long
Dim SelAddress As String
Dim Aux As String

Set MyRange = Selection
SelAddress = Selection.Address

SelAddress = Mid(SelAddress, 2, Len(SelAddress) - InStr(1, SelAddress, "$", vbBinaryCompare))
Aux = Mid(SelAddress, 1, InStr(1, SelAddress, "$", vbBinaryCompare) - 1)
SelAddress = Mid(SelAddress, Len(Aux) + 2, Len(SelAddress) - Len(Aux))
Aux = Aux & Mid(SelAddress, 1, InStr(1, SelAddress, "$", vbBinaryCompare) - 2)

FirstCol = Range(Aux).Column
FirstRow = Range(Aux).Row

SelAddress = Mid(Selection.Address, Len(Aux) + 5, Len(SelAddress) - Len(Aux))
Aux = Mid(SelAddress, 1, InStr(1, SelAddress, "$", vbBinaryCompare) - 1)
SelAddress = Mid(SelAddress, Len(Aux) + 2, Len(SelAddress) - Len(Aux))
Aux = Aux & Mid(SelAddress, InStr(1, SelAddress, "$", vbBinaryCompare) + 1, Len(SelAddress))

LastCol = Range(Aux).Column
LastRow = Range(Aux).Row


For i = FirstCol To LastCol Step 1
    Set MyRange = ActiveWorkbook.Worksheets("Raw Data").Range(Cells(FirstRow, i), Cells(LastRow, i))
    ActiveWorkbook.Worksheets("Raw Data").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Raw Data").Sort.SortFields.Add Key:=MyRange, _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Raw Data").Sort
        .SetRange MyRange
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
Next


End Sub

Надеюсь, это поможет!

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...