Порядок сортировки Excel – специальные символы не первые

Я использую макрос для сортировки таблицы по данным в одном столбце:

ActiveWorkbook.Worksheets("sheet").Sort.SortFields.Add Key:=Range(sortRange), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal 

Есть ли способ сделать этот код сортировкой в ​​этом порядке: сначала 0-9, затем AZ, а затем специальные символы (есть как минимум • и +, которые мне нравятся последним в порядке сортировки)?

Хорошо, это звучало как забавная задача, поэтому я пробовал подход Vityata с разными списками на другом листе.

 Sub crazySort() Dim ws As Worksheet Dim ws2 As Worksheet Dim lastRow As Long Dim yourcolumnindex, letters, numbers, others As Long Dim i As Long Set ws = Worksheets("sheet") 'This is the sheet for our temp lists, rename accordingly Set ws2 = Worksheets("tempsheet") columnsCount = x i = 1 letters = 1 others = 1 numbers = 1 With ws For j = 1 to columnsCount 'loop through all the cells in your column 'change yourcolumnindex accordingly Do While .Cells(i, j) <> "" 'check for the ASCII-code of the first character in every list Select Case Asc(Left(.Cells(i, j), 1)) Case 65 To 90, 97 To 122 'if it's a letter, put it in column 1 ws2.Cells(letters, 1) = .Cells(i, j) letters = letters + 1 Case 48 To 57 'if it's a cipher, put it in column 2 ws2.Cells(numbers, 2) = .Cells(i, j) numbers = numbers + 1 Case Else 'is it something else, put it in column 3 ws2.Cells(others, 3) = .Cells(i, j) others = others + 1 End Select i = i + 1 Loop Next End With End Sub 

Эта часть просто содержит разделение списка, но отсюда он просто сортирует и копирует / вставляет обратно.

Получайте удовольствие от этого.

@Tom, спасибо, что упомянул меня 🙂 Собственно, я думал о чем-то более подобном:

 Public Sub SortMe(rng_selection As Range) Dim rng_cell As Range Dim lst_numbers As New Collection Dim lst_letters As New Collection Dim lst_others As New Collection Dim rng_new As Range For Each rng_cell In rng_selection Select Case Asc(Left(rng_cell, 1)) Case 65 To 90, 97 To 122 lst_letters.Add rng_cell.Text Case 48 To 58 lst_numbers.Add rng_cell.Text Case Else lst_others.Add rng_cell.Text End Select Next rng_cell Call SortCollection(lst_numbers) Call SortCollection(lst_letters) Call SortCollection(lst_others) For Each rng_cell In rng_selection If lst_numbers.Count Then rng_cell = lst_numbers.Item(1) lst_numbers.Remove (1) ElseIf lst_letters.Count Then rng_cell = lst_letters.Item(1) lst_letters.Remove (1) ElseIf lst_others.Count Then rng_cell = lst_others(1) lst_others.Remove (1) End If Next rng_cell Set rng_new = rng_selection.Offset(0, 1) End Sub Sub SortCollection(ByRef oCollection As Collection, Optional bSortAscending As Boolean = True) 'taken from http://visualbasic.happycodings.com/applications-vba/code27.html Dim lSort1 As Long, lSort2 As Long Dim vTempItem1 As Variant, vTempItem2 As Variant, bSwap As Boolean On Error GoTo ErrFailed For lSort1 = 1 To oCollection.Count - 1 For lSort2 = lSort1 + 1 To oCollection.Count If bSortAscending Then If oCollection(lSort1) > oCollection(lSort2) Then bSwap = True Else bSwap = False End If Else If oCollection(lSort1) < oCollection(lSort2) Then bSwap = True Else bSwap = False End If End If If bSwap Then 'Store the items If VarType(oCollection(lSort1)) = vbObject Then Set vTempItem1 = oCollection(lSort1) Else vTempItem1 = oCollection(lSort1) End If If VarType(oCollection(lSort2)) = vbObject Then Set vTempItem2 = oCollection(lSort2) Else vTempItem2 = oCollection(lSort2) End If 'Swap the items over oCollection.Add vTempItem1, , lSort2 oCollection.Add vTempItem2, , lSort1 'Delete the original items oCollection.Remove lSort1 + 1 oCollection.Remove lSort2 + 1 End If Next Next Exit Sub ErrFailed: Debug.Print "Error with CollectionSort: " & Err.Description CollectionSort = Err.Number On Error GoTo 0 End Sub 

Он просто выглядит большим, сортировка sub довольно велика, но я скопировал и вставил его. Это сработало для меня. Если вы хотите называть это, напишите в непосредственном окне call SortMe(selection) и не забудьте выбрать диапазон. 🙂 Приятного вечера: D

Interesting Posts

Вставить новую строку без наложения свойств блокировки

Чтение листа excel с использованием c # с объединенными ячейками для создания xml

excel multiple при ошибке goto

отображение графика с функцией if в EXCEL

Преобразование десятичного в процентах

Как полностью отключить макросы в Excel 2013 C # Api

Скрыть неактивные рабочие листы в Excel VBA

VBA не выбирает последнюю строку в моих данных

Файл Excel исчезает из обозревателя решений при его сохранении

Индекс находился за пределами массива при экспорте данных в excel в C #

Импорт файла Excel, но количество столбцов меняется

Не удалось загрузить надстройку Excel 2003

Как остановить одну сводную таблицу от влияния на диаграмму, созданную из другой сводной таблицы?

Пытаемся объединиться в dataframe, но он продолжает создавать новые столбцы

Excel VBA – сравнение значений в двух столбцах и копирование совпадающей строки на новый лист

Давайте будем гением компьютера.