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

Вход

Регистрация

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

 

= Мир MS Excel/Код сортировки необходимо усовершенствовать для Excel - Мир MS Excel

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

Excel 2013
[vba]
Код
Sub Сортировка()
    Columns("F:F").Select
    ActiveWorkbook.Worksheets("СУ10").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("СУ10").Sort.SortFields.Add Key:=Range("F2:F5000"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Файлик").Sort
        .SetRange Range("F1:F5000")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub
[/vba]

ка этот код сделать чтоб он работал на любом листе
и второе выбрать столбец, а потом сортировать
жду ваших решений

Сортировать нужно 100 листов excel каждый столбец в листе


web-программист
 
Ответить
Сообщение[vba]
Код
Sub Сортировка()
    Columns("F:F").Select
    ActiveWorkbook.Worksheets("СУ10").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("СУ10").Sort.SortFields.Add Key:=Range("F2:F5000"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Файлик").Sort
        .SetRange Range("F1:F5000")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub
[/vba]

ка этот код сделать чтоб он работал на любом листе
и второе выбрать столбец, а потом сортировать
жду ваших решений

Сортировать нужно 100 листов excel каждый столбец в листе

Автор - next777
Дата добавления - 31.03.2016 в 04:15
dima_dan2012 Дата: Четверг, 31.03.2016, 08:44 | Сообщение № 2
Группа: Пользователи
Ранг: Новичок
Сообщений: 36
Репутация: 7 ±
Замечаний: 0% ±

Excel 2003,2007
Здравствуйте ! Только критерии сортировки надо глянуть.
[vba]
Код
Sub qwe()
For Item = 1 To ActiveWorkbook.Worksheets.Count
With ActiveWorkbook.Worksheets(Item)
        .Activate
        .Columns("F:F").Select
       
Selection.Sort Key1:=Range("F2:F5000"), Order1:=xlAscending, Header:=xlYes, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
   
End With
Next Item
End Sub
[/vba]
 
Ответить
СообщениеЗдравствуйте ! Только критерии сортировки надо глянуть.
[vba]
Код
Sub qwe()
For Item = 1 To ActiveWorkbook.Worksheets.Count
With ActiveWorkbook.Worksheets(Item)
        .Activate
        .Columns("F:F").Select
       
Selection.Sort Key1:=Range("F2:F5000"), Order1:=xlAscending, Header:=xlYes, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
   
End With
Next Item
End Sub
[/vba]

Автор - dima_dan2012
Дата добавления - 31.03.2016 в 08:44
next777 Дата: Четверг, 31.03.2016, 22:36 | Сообщение № 3
Группа: Пользователи
Ранг: Новичок
Сообщений: 20
Репутация: 0 ±
Замечаний: 20% ±

Excel 2013
Здравствуйте ! Только критерии сортировки надо глянуть.

можно обьединить все обрабатываемые столбцы, т.е. нужно несколько разных столбцов с цветными вверху, чтобы эти цветные дальше обрабатывать

Файл во вложении с пояснениями
К сообщению приложен файл: 4388127.xls(77Kb)


web-программист

Сообщение отредактировал next777 - Четверг, 31.03.2016, 22:37
 
Ответить
Сообщение
Здравствуйте ! Только критерии сортировки надо глянуть.

можно обьединить все обрабатываемые столбцы, т.е. нужно несколько разных столбцов с цветными вверху, чтобы эти цветные дальше обрабатывать

Файл во вложении с пояснениями

Автор - next777
Дата добавления - 31.03.2016 в 22:36
dima_dan2012 Дата: Пятница, 01.04.2016, 08:43 | Сообщение № 4
Группа: Пользователи
Ранг: Новичок
Сообщений: 36
Репутация: 7 ±
Замечаний: 0% ±

Excel 2003,2007
Здравствуйте! Что-то типа такого.
[vba]
Код

Sub sort_myMY()
For Item = 1 To ActiveWorkbook.Worksheets.Count
    
    With ActiveWorkbook.Worksheets(Item)
    For SEL = 2 To 13
        .Activate
        arr_ITEM = Cells(Rows.Count, SEL).End(xlUp).Row
        .Columns(SEL).Select
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=Range(Cells(2, SEL), Cells(arr_ITEM, SEL)), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
         With ActiveWorkbook.Worksheets(Item).Sort
        .SetRange Range(Cells(2, SEL), Cells(arr_ITEM, SEL))
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
         End With
        Worksheets(Item).Range(Cells(2, SEL), Cells(arr_ITEM, SEL)).RemoveDuplicates Columns:=1, Header:=xlNo
         
         
         
         Next SEL
     End With
Next Item
End Sub
[/vba]
К сообщению приложен файл: 4388127_my-my.xlsm(42Kb)


Сообщение отредактировал dima_dan2012 - Пятница, 01.04.2016, 13:01
 
Ответить
СообщениеЗдравствуйте! Что-то типа такого.
[vba]
Код

Sub sort_myMY()
For Item = 1 To ActiveWorkbook.Worksheets.Count
    
    With ActiveWorkbook.Worksheets(Item)
    For SEL = 2 To 13
        .Activate
        arr_ITEM = Cells(Rows.Count, SEL).End(xlUp).Row
        .Columns(SEL).Select
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=Range(Cells(2, SEL), Cells(arr_ITEM, SEL)), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
         With ActiveWorkbook.Worksheets(Item).Sort
        .SetRange Range(Cells(2, SEL), Cells(arr_ITEM, SEL))
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
         End With
        Worksheets(Item).Range(Cells(2, SEL), Cells(arr_ITEM, SEL)).RemoveDuplicates Columns:=1, Header:=xlNo
         
         
         
         Next SEL
     End With
Next Item
End Sub
[/vba]

Автор - dima_dan2012
Дата добавления - 01.04.2016 в 08:43
Wasilich Дата: Пятница, 01.04.2016, 11:50 | Сообщение № 5
Группа: Друзья
Ранг: Ветеран
Сообщений: 878
Репутация: 222 ±
Замечаний: 0% ±

2003
Цитата
можно кнопку Duplicate доработать, если не окрасил написать - Дубликатов нет
кнопка удаляет окончательно из столбца повторы но, почему то это делает очень долго, когда выбираешь весь столбец
Малость подправил.
К сообщению приложен файл: next777.xls(88Kb)
 
Ответить
Сообщение
Цитата
можно кнопку Duplicate доработать, если не окрасил написать - Дубликатов нет
кнопка удаляет окончательно из столбца повторы но, почему то это делает очень долго, когда выбираешь весь столбец
Малость подправил.

Автор - Wasilich
Дата добавления - 01.04.2016 в 11:50
next777 Дата: Пятница, 01.04.2016, 13:34 | Сообщение № 6
Группа: Пользователи
Ранг: Новичок
Сообщений: 20
Репутация: 0 ±
Замечаний: 20% ±

Excel 2013
Малость подправил.
К сообщению приложен файл: next777.xls(88Kb)

Супер, спасибо вам


web-программист
 
Ответить
Сообщение
Малость подправил.
К сообщению приложен файл: next777.xls(88Kb)

Супер, спасибо вам

Автор - next777
Дата добавления - 01.04.2016 в 13:34
next777 Дата: Пятница, 01.04.2016, 14:21 | Сообщение № 7
Группа: Пользователи
Ранг: Новичок
Сообщений: 20
Репутация: 0 ±
Замечаний: 20% ±

Excel 2013
Duplicate доработать
как сделать, чтобы шапку не окрашивало, т.е. не с 1 строки проверяло а с 2 по столбцу и ниже

и кнопочка Remove удаляла только в своих столбцах, не сравнивала соседний столбец, когда выделаешь несколько столбцов удаляет как то странновато, так его логику удаления не смог понять,) по одному столбцу великолепно удаляет, а вот несколько непонятно удаляет


web-программист

Сообщение отредактировал next777 - Пятница, 01.04.2016, 14:36
 
Ответить
Сообщение
Duplicate доработать
как сделать, чтобы шапку не окрашивало, т.е. не с 1 строки проверяло а с 2 по столбцу и ниже

и кнопочка Remove удаляла только в своих столбцах, не сравнивала соседний столбец, когда выделаешь несколько столбцов удаляет как то странновато, так его логику удаления не смог понять,) по одному столбцу великолепно удаляет, а вот несколько непонятно удаляет

Автор - next777
Дата добавления - 01.04.2016 в 14:21
next777 Дата: Пятница, 01.04.2016, 15:17 | Сообщение № 8
Группа: Пользователи
Ранг: Новичок
Сообщений: 20
Репутация: 0 ±
Замечаний: 20% ±

Excel 2013
К сообщению приложен файл: 4388127_my-my.xlsm

спасибо, очень интересно работает
была бы еще инфа в окошке, сколько удалил


web-программист

Сообщение отредактировал next777 - Пятница, 01.04.2016, 15:18
 
Ответить
Сообщение
К сообщению приложен файл: 4388127_my-my.xlsm

спасибо, очень интересно работает
была бы еще инфа в окошке, сколько удалил

Автор - next777
Дата добавления - 01.04.2016 в 15:17
next777 Дата: Суббота, 02.04.2016, 00:28 | Сообщение № 9
Группа: Пользователи
Ранг: Новичок
Сообщений: 20
Репутация: 0 ±
Замечаний: 20% ±

Excel 2013
Здравствуйте! Что-то типа такого.

Sub sort_myMY()
For Item = 1 To ActiveWorkbook.Worksheets.Count

With ActiveWorkbook.Worksheets(Item)
For SEL = 2 To 13
.Activate
arr_ITEM = Cells(Rows.Count, SEL).End(xlUp).Row
.Columns(SEL).Select
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=Range(Cells(2, SEL), Cells(arr_ITEM, SEL)), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets(Item).Sort
.SetRange Range(Cells(2, SEL), Cells(arr_ITEM, SEL))
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Worksheets(Item).Range(Cells(2, SEL), Cells(arr_ITEM, SEL)).RemoveDuplicates Columns:=1, Header:=xlNo

Next SEL
End With


а можно без сортировки, только на удаление дубликатов акцентировать? т.е убрать из кода сортировку, самому не получается изменить глючит когда окно всталяю сколько удалило


web-программист

Сообщение отредактировал next777 - Суббота, 02.04.2016, 00:30
 
Ответить
Сообщение
Здравствуйте! Что-то типа такого.

Sub sort_myMY()
For Item = 1 To ActiveWorkbook.Worksheets.Count

With ActiveWorkbook.Worksheets(Item)
For SEL = 2 To 13
.Activate
arr_ITEM = Cells(Rows.Count, SEL).End(xlUp).Row
.Columns(SEL).Select
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=Range(Cells(2, SEL), Cells(arr_ITEM, SEL)), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets(Item).Sort
.SetRange Range(Cells(2, SEL), Cells(arr_ITEM, SEL))
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Worksheets(Item).Range(Cells(2, SEL), Cells(arr_ITEM, SEL)).RemoveDuplicates Columns:=1, Header:=xlNo

Next SEL
End With


а можно без сортировки, только на удаление дубликатов акцентировать? т.е убрать из кода сортировку, самому не получается изменить глючит когда окно всталяю сколько удалило

Автор - next777
Дата добавления - 02.04.2016 в 00:28
dima_dan2012 Дата: Суббота, 02.04.2016, 21:33 | Сообщение № 10
Группа: Пользователи
Ранг: Новичок
Сообщений: 36
Репутация: 7 ±
Замечаний: 0% ±

Excel 2003,2007
Здравствуйте! Тут совсем просто;)
[vba]
Код

Sub sort_myMY()
For Item = 1 To ActiveWorkbook.Worksheets.Count
    With ActiveWorkbook.Worksheets(Item)
    For SEL = 1 To 13
        .Activate
        arr_ITEM = Cells(Rows.Count, SEL).End(xlUp).Row
        Worksheets(Item).Range(Cells(2, SEL), Cells(arr_ITEM, SEL)).RemoveDuplicates Columns:=1, Header:=xlNo  
         Next SEL
     End With
Next Item
End Sub
[/vba]
Добавил вывод количества удаленных дублкатов по всем страницам
[vba]
Код
Dim c As Integer
Sub sort_myMY()
c = 0
For Item = 1 To ActiveWorkbook.Worksheets.Count
    
    With ActiveWorkbook.Worksheets(Item)
    For SEL = 1 To 13
        
        .Activate
        arr_ITEm_start = Cells(Rows.Count, SEL).End(xlUp).Row
       
        Worksheets(Item).Range(Cells(2, SEL), Cells(arr_ITEm_start, SEL)).RemoveDuplicates Columns:=1, Header:=xlNo
        arr_item_end = Cells(Rows.Count, SEL).End(xlUp).Row
         
         c = c + arr_ITEm_start - arr_item_end
         Next SEL
     End With
Next Item
MsgBox ("Кол-во удаленных дубликатов " & c)
End Sub
[/vba]


Сообщение отредактировал dima_dan2012 - Суббота, 02.04.2016, 23:57
 
Ответить
СообщениеЗдравствуйте! Тут совсем просто;)
[vba]
Код

Sub sort_myMY()
For Item = 1 To ActiveWorkbook.Worksheets.Count
    With ActiveWorkbook.Worksheets(Item)
    For SEL = 1 To 13
        .Activate
        arr_ITEM = Cells(Rows.Count, SEL).End(xlUp).Row
        Worksheets(Item).Range(Cells(2, SEL), Cells(arr_ITEM, SEL)).RemoveDuplicates Columns:=1, Header:=xlNo  
         Next SEL
     End With
Next Item
End Sub
[/vba]
Добавил вывод количества удаленных дублкатов по всем страницам
[vba]
Код
Dim c As Integer
Sub sort_myMY()
c = 0
For Item = 1 To ActiveWorkbook.Worksheets.Count
    
    With ActiveWorkbook.Worksheets(Item)
    For SEL = 1 To 13
        
        .Activate
        arr_ITEm_start = Cells(Rows.Count, SEL).End(xlUp).Row
       
        Worksheets(Item).Range(Cells(2, SEL), Cells(arr_ITEm_start, SEL)).RemoveDuplicates Columns:=1, Header:=xlNo
        arr_item_end = Cells(Rows.Count, SEL).End(xlUp).Row
         
         c = c + arr_ITEm_start - arr_item_end
         Next SEL
     End With
Next Item
MsgBox ("Кол-во удаленных дубликатов " & c)
End Sub
[/vba]

Автор - dima_dan2012
Дата добавления - 02.04.2016 в 21:33
next777 Дата: Воскресенье, 03.04.2016, 00:25 | Сообщение № 11
Группа: Пользователи
Ранг: Новичок
Сообщений: 20
Репутация: 0 ±
Замечаний: 20% ±

Excel 2013
Добавил вывод количества удаленных дублкатов по всем страницам

Спасибо за все, только вот пустоты тоже считает их нужно было отдельно как то
просто удалены дубликат цифр не считая пустот


web-программист

Сообщение отредактировал next777 - Воскресенье, 03.04.2016, 06:15
 
Ответить
Сообщение
Добавил вывод количества удаленных дублкатов по всем страницам

Спасибо за все, только вот пустоты тоже считает их нужно было отдельно как то
просто удалены дубликат цифр не считая пустот

Автор - next777
Дата добавления - 03.04.2016 в 00:25
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Код сортировки необходимо усовершенствовать для Excel (Макросы/Sub)
Страница 1 из 11
Поиск:

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