Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Сортировка макросом смешанного столбца - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Сортировка макросом смешанного столбца (Макросы/Sub)
Сортировка макросом смешанного столбца
Aumi Дата: Среда, 04.04.2018, 10:56 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 20
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Здравствуйте,

В таблице есть столбец "Зоны", который содержит в себе такие значения такого вида: числоА!числоПП
притом длина их разной может быть, т е и просто 1А или 1ПП, либо 23А!65А!2ПП!33ПП. Примеры возможных комбинаций есть в файле.

Нужно этот столбец отсортировать так: первыми шли по возрастанию с буквой А, а потом по возрастанию с буквой ПП

Пример результата сортировки:
2A
5A!56A
11A!12A
12A!15A!7ПП!10ПП
717A!15ПП
1187A!1188A
1194A!1195A!1196A
1ПП!56ПП
2ПП!4ПП
11ПП!58ПП
30ПП

А стандартная сортировка не так делает. Возможно это решить с помощью макроса? Мне именно макрос нужен, т к выгрузку в эксель делаю из бд с помощью с# и оттуда хочу вызывать макрос.
К сообщению приложен файл: 7122747.xlsx(9.3 Kb)
 
Ответить
СообщениеЗдравствуйте,

В таблице есть столбец "Зоны", который содержит в себе такие значения такого вида: числоА!числоПП
притом длина их разной может быть, т е и просто 1А или 1ПП, либо 23А!65А!2ПП!33ПП. Примеры возможных комбинаций есть в файле.

Нужно этот столбец отсортировать так: первыми шли по возрастанию с буквой А, а потом по возрастанию с буквой ПП

Пример результата сортировки:
2A
5A!56A
11A!12A
12A!15A!7ПП!10ПП
717A!15ПП
1187A!1188A
1194A!1195A!1196A
1ПП!56ПП
2ПП!4ПП
11ПП!58ПП
30ПП

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

Автор - Aumi
Дата добавления - 04.04.2018 в 10:56
sboy Дата: Среда, 04.04.2018, 12:06 | Сообщение № 2
Группа: Проверенные
Ранг: Старожил
Сообщений: 1942
Репутация: 563 ±
Замечаний: 0% ±

Excel 2010
Добрый день.
[vba]
Код
Sub sort()
Application.ScreenUpdating = False
    arr = Range("a2:a" & Cells(Rows.Count, 1).End(xlUp).Row).Value
    Dim arr1()
    ReDim arr1(1 To UBound(arr), 1 To 2)
        With CreateObject("VBScript.RegExp")
            For i = 1 To UBound(arr)
                .Pattern = "\d+(?=A)"
                If .test(arr(i, 1)) Then
                    arr1(i, 1) = CDbl(.Execute(arr(i, 1))(0))
                    arr1(i, 2) = "А"
                    Else
                        .Pattern = "\d+"
                        arr1(i, 1) = CDbl(.Execute(arr(i, 1))(0))
                        arr1(i, 2) = "П"
                End If
            Next
        End With
            Range("b2").Resize(i - 1, 2).Value = arr1
        With ActiveSheet.sort
            .SortFields.Add Key:=Range("C2:C" & i), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .SortFields.Add Key:=Range("B2:B" & i), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .SetRange Range("A2:C" & i)
            .Header = xlGuess
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        Range("b2").Resize(i - 1, 2).ClearContents
Application.ScreenUpdating = True
End Sub
[/vba]
К сообщению приложен файл: 7122747.xlsm(19.3 Kb)
 
Ответить
СообщениеДобрый день.
[vba]
Код
Sub sort()
Application.ScreenUpdating = False
    arr = Range("a2:a" & Cells(Rows.Count, 1).End(xlUp).Row).Value
    Dim arr1()
    ReDim arr1(1 To UBound(arr), 1 To 2)
        With CreateObject("VBScript.RegExp")
            For i = 1 To UBound(arr)
                .Pattern = "\d+(?=A)"
                If .test(arr(i, 1)) Then
                    arr1(i, 1) = CDbl(.Execute(arr(i, 1))(0))
                    arr1(i, 2) = "А"
                    Else
                        .Pattern = "\d+"
                        arr1(i, 1) = CDbl(.Execute(arr(i, 1))(0))
                        arr1(i, 2) = "П"
                End If
            Next
        End With
            Range("b2").Resize(i - 1, 2).Value = arr1
        With ActiveSheet.sort
            .SortFields.Add Key:=Range("C2:C" & i), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .SortFields.Add Key:=Range("B2:B" & i), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .SetRange Range("A2:C" & i)
            .Header = xlGuess
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        Range("b2").Resize(i - 1, 2).ClearContents
Application.ScreenUpdating = True
End Sub
[/vba]

Автор - sboy
Дата добавления - 04.04.2018 в 12:06
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Сортировка макросом смешанного столбца (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс цитирования
© 2010-2018 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!