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

Вход

Регистрация

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

 

= Мир MS Excel/сортировка выделенного диапазона макросом - Мир MS Excel

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

Excel 2010
Подскажите пожалуйста как организовать сортировку выделенного диапазона макросом? В коде постарался максимально расписать все
К сообщению приложен файл: report.xls(50Kb)
 
Ответить
СообщениеПодскажите пожалуйста как организовать сортировку выделенного диапазона макросом? В коде постарался максимально расписать все

Автор - Flatcher
Дата добавления - 21.02.2016 в 20:06
Апострофф Дата: Воскресенье, 21.02.2016, 20:55 | Сообщение № 2
Группа: Пользователи
Ранг: Участник
Сообщений: 71
Репутация: 28 ±
Замечаний: 0% ±

Excel 2003
С минимальным отклонением от стиля и если я угадал поля сортировки -

[vba]
Код
Sub СОРТИРОВКА()
Dim rn As Range
Dim vAdr1 As String
Dim vAdr2 As String
' НА ВСЯКИЙ СЛУЧАЙ АКТИВИРУЕМ ПЕРВУЮ ЯЧЕЙКУ
Cells(1, 1).Select
' НАХОДИМ ПЕРВУЮ ЯЧЕЙКУ СО СЛОВОМ ОПЕРАЦИЯ
Cells.Find(What:="Операция", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Select
' ЗАПИСЫВАЕМ АДРЕС НАЙДЕННОЙ ЯЧЕЙКИ В ПЕРЕМЕННУЮ
vAdr1 = Selection.Address
' ВЫДЕЛЯЕМ СТОЛБЕЦ С ЗНАЧЕНИЯМИ ОТ НАЙДЕННОЙ ЯЧЕЙКИ ВНИЗ
Range(Selection, Selection.End(xlDown)).Select
' И ВЛЕВО
Range(Selection, Selection.End(xlToLeft)).Select
' ПРИМЕНЯЕМ СОРТИРОВКУ
Set rn = Selection
rn.Columns(1).NumberFormat = "dd.mm.yyyy"
rn.Columns(1).Value = rn.Columns(1).Value
rn.Columns(2).NumberFormat = "hh:mm:ss"
rn.Columns(2).Value = rn.Columns(2).Value
    rn.Sort Key1:=[a1], Order1:=xlAscending, Key2:= _
        [b1], Order2:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom, DataOption1:=xlSortTextAsNumbers, _
        DataOption2:=xlSortTextAsNumbers

'??????

' СМЕЩАЕМСЯ НА ОДНУ СТРОКУ ВНИЗ ДЛЯ ПРОДОЛЖЕНИЯ ПОИСКА
ActiveCell.Offset(1, 0).Select
' ЦИКЛ
Do
' ПРОДОЛЖАЕМ ПОИСК ДАЛЕЕ
Cells.FindNext(After:=ActiveCell).Select
' ЗАПИСЫВАЕМ АДРЕС НАЙДЕННОЙ ЯЧЕЙКИ В ПЕРЕМЕННУЮ
vAdr2 = Selection.Address
' СРАВНИВАЕМ ПЕРЕМЕННЫЕ (ЕСЛИ СОВПАДАЮТ С АДРЕСОМ ПЕРВОЙ НАЙДЕННОЙ ЯЧЕЙКИ ОСТАНАВЛИВАЕМ ЦИКЛ)
If Not vAdr1 <> vAdr2 Then Exit Do
' ВЫДЕЛЯЕМ СТОЛБЕЦ С ЗНАЧЕНИЯМИ ОТ НАЙДЕННОЙ ЯЧЕЙКИ ВНИЗ
Range(Selection, Selection.End(xlDown)).Select
' И ВЛЕВО
Range(Selection, Selection.End(xlToLeft)).Select
' ПРИМЕНЯЕМ СОРТИРОВКУ
Set rn = Selection
rn.Columns(1).NumberFormat = "dd.mm.yyyy"
rn.Columns(1).Value = rn.Columns(1).Value
rn.Columns(2).NumberFormat = "hh:mm:ss"
rn.Columns(2).Value = rn.Columns(2).Value
    rn.Sort Key1:=[a1], Order1:=xlAscending, Key2:= _
        [b1], Order2:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom, DataOption1:=xlSortTextAsNumbers, _
        DataOption2:=xlSortTextAsNumbers

'??????

' СМЕЩАЕМСЯ НА ОДНУ СТРОКУ ВНИЗ ДЛЯ ПРОДОЛЖЕНИЯ ПОИСКА
ActiveCell.Offset(1, 0).Select
Loop
End Sub
[/vba]
 
Ответить
СообщениеС минимальным отклонением от стиля и если я угадал поля сортировки -

[vba]
Код
Sub СОРТИРОВКА()
Dim rn As Range
Dim vAdr1 As String
Dim vAdr2 As String
' НА ВСЯКИЙ СЛУЧАЙ АКТИВИРУЕМ ПЕРВУЮ ЯЧЕЙКУ
Cells(1, 1).Select
' НАХОДИМ ПЕРВУЮ ЯЧЕЙКУ СО СЛОВОМ ОПЕРАЦИЯ
Cells.Find(What:="Операция", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Select
' ЗАПИСЫВАЕМ АДРЕС НАЙДЕННОЙ ЯЧЕЙКИ В ПЕРЕМЕННУЮ
vAdr1 = Selection.Address
' ВЫДЕЛЯЕМ СТОЛБЕЦ С ЗНАЧЕНИЯМИ ОТ НАЙДЕННОЙ ЯЧЕЙКИ ВНИЗ
Range(Selection, Selection.End(xlDown)).Select
' И ВЛЕВО
Range(Selection, Selection.End(xlToLeft)).Select
' ПРИМЕНЯЕМ СОРТИРОВКУ
Set rn = Selection
rn.Columns(1).NumberFormat = "dd.mm.yyyy"
rn.Columns(1).Value = rn.Columns(1).Value
rn.Columns(2).NumberFormat = "hh:mm:ss"
rn.Columns(2).Value = rn.Columns(2).Value
    rn.Sort Key1:=[a1], Order1:=xlAscending, Key2:= _
        [b1], Order2:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom, DataOption1:=xlSortTextAsNumbers, _
        DataOption2:=xlSortTextAsNumbers

'??????

' СМЕЩАЕМСЯ НА ОДНУ СТРОКУ ВНИЗ ДЛЯ ПРОДОЛЖЕНИЯ ПОИСКА
ActiveCell.Offset(1, 0).Select
' ЦИКЛ
Do
' ПРОДОЛЖАЕМ ПОИСК ДАЛЕЕ
Cells.FindNext(After:=ActiveCell).Select
' ЗАПИСЫВАЕМ АДРЕС НАЙДЕННОЙ ЯЧЕЙКИ В ПЕРЕМЕННУЮ
vAdr2 = Selection.Address
' СРАВНИВАЕМ ПЕРЕМЕННЫЕ (ЕСЛИ СОВПАДАЮТ С АДРЕСОМ ПЕРВОЙ НАЙДЕННОЙ ЯЧЕЙКИ ОСТАНАВЛИВАЕМ ЦИКЛ)
If Not vAdr1 <> vAdr2 Then Exit Do
' ВЫДЕЛЯЕМ СТОЛБЕЦ С ЗНАЧЕНИЯМИ ОТ НАЙДЕННОЙ ЯЧЕЙКИ ВНИЗ
Range(Selection, Selection.End(xlDown)).Select
' И ВЛЕВО
Range(Selection, Selection.End(xlToLeft)).Select
' ПРИМЕНЯЕМ СОРТИРОВКУ
Set rn = Selection
rn.Columns(1).NumberFormat = "dd.mm.yyyy"
rn.Columns(1).Value = rn.Columns(1).Value
rn.Columns(2).NumberFormat = "hh:mm:ss"
rn.Columns(2).Value = rn.Columns(2).Value
    rn.Sort Key1:=[a1], Order1:=xlAscending, Key2:= _
        [b1], Order2:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom, DataOption1:=xlSortTextAsNumbers, _
        DataOption2:=xlSortTextAsNumbers

'??????

' СМЕЩАЕМСЯ НА ОДНУ СТРОКУ ВНИЗ ДЛЯ ПРОДОЛЖЕНИЯ ПОИСКА
ActiveCell.Offset(1, 0).Select
Loop
End Sub
[/vba]

Автор - Апострофф
Дата добавления - 21.02.2016 в 20:55
nilem Дата: Воскресенье, 21.02.2016, 20:55 | Сообщение № 3
Группа: Авторы
Ранг: Старожил
Сообщений: 1120
Репутация: 417 ±
Замечаний: 0% ±

Excel 2013
попробуйте так:
[vba]
Код
Sub СОРТИРОВКА()
Dim r As Range, adr$
Set r = Sheets("Report").UsedRange.Find("Операция", LookIn:=xlValues, lookat:=xlWhole)
If Not r Is Nothing Then
    adr = r.Address
    Do
        With r.CurrentRegion
            With .Resize(.Rows.Count - 1)
                .Sort Key1:=.Cells(1, 1), Order1:=xlAscending, _
                      Key2:=.Cells(1, 2), Order2:=xlAscending, Header:=xlYes
            End With
        End With
        Set r = Sheets("Report").UsedRange.FindNext(r)
    Loop While r.Address <> adr
End If
End Sub
[/vba]


Яндекс.Деньги 4100159601573
 
Ответить
Сообщениепопробуйте так:
[vba]
Код
Sub СОРТИРОВКА()
Dim r As Range, adr$
Set r = Sheets("Report").UsedRange.Find("Операция", LookIn:=xlValues, lookat:=xlWhole)
If Not r Is Nothing Then
    adr = r.Address
    Do
        With r.CurrentRegion
            With .Resize(.Rows.Count - 1)
                .Sort Key1:=.Cells(1, 1), Order1:=xlAscending, _
                      Key2:=.Cells(1, 2), Order2:=xlAscending, Header:=xlYes
            End With
        End With
        Set r = Sheets("Report").UsedRange.FindNext(r)
    Loop While r.Address <> adr
End If
End Sub
[/vba]

Автор - nilem
Дата добавления - 21.02.2016 в 20:55
Flatcher Дата: Воскресенье, 21.02.2016, 21:11 | Сообщение № 4
Группа: Проверенные
Ранг: Участник
Сообщений: 70
Репутация: 1 ±
Замечаний: 0% ±

Excel 2010
Апострофф, спасибо работает))
 
Ответить
СообщениеАпострофф, спасибо работает))

Автор - Flatcher
Дата добавления - 21.02.2016 в 21:11
Flatcher Дата: Воскресенье, 21.02.2016, 21:12 | Сообщение № 5
Группа: Проверенные
Ранг: Участник
Сообщений: 70
Репутация: 1 ±
Замечаний: 0% ±

Excel 2010
nilem, спасибо! тоже все заработало! насколько можно оказывается сокращать код)))
 
Ответить
Сообщениеnilem, спасибо! тоже все заработало! насколько можно оказывается сокращать код)))

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

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