Код сортировки необходимо усовершенствовать для 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 каждый столбец в листе
[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
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
Группа: Пользователи
Ранг: Новичок
Сообщений: 38
Репутация:
8
±
Замечаний:
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
WM :Z116994103939
Ответить
Сообщение Здравствуйте ! Только критерии сортировки надо глянуть. [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
Здравствуйте ! Только критерии сортировки надо глянуть.
можно обьединить все обрабатываемые столбцы, т.е. нужно несколько разных столбцов с цветными вверху, чтобы эти цветные дальше обрабатывать Файл во вложении с пояснениями
Здравствуйте ! Только критерии сортировки надо глянуть.
можно обьединить все обрабатываемые столбцы, т.е. нужно несколько разных столбцов с цветными вверху, чтобы эти цветные дальше обрабатывать Файл во вложении с пояснениямиnext777
web-программист
Сообщение отредактировал next777 - Четверг, 31.03.2016, 22:37
Ответить
Сообщение Здравствуйте ! Только критерии сортировки надо глянуть.
можно обьединить все обрабатываемые столбцы, т.е. нужно несколько разных столбцов с цветными вверху, чтобы эти цветные дальше обрабатывать Файл во вложении с пояснениямиАвтор - next777 Дата добавления - 31.03.2016 в 22:36
dima_dan2012
Дата: Пятница, 01.04.2016, 08:43 |
Сообщение № 4
Группа: Пользователи
Ранг: Новичок
Сообщений: 38
Репутация:
8
±
Замечаний:
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]
Здравствуйте! Что-то типа такого. [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
WM :Z116994103939
Сообщение отредактировал 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
Группа: Друзья
Ранг: Старожил
Сообщений: 1232
Репутация:
326
±
Замечаний:
0% ±
2003
Цитата
можно кнопку Duplicate доработать, если не окрасил написать - Дубликатов нет кнопка удаляет окончательно из столбца повторы но, почему то это делает очень долго, когда выбираешь весь столбец
Малость подправил.
Цитата
можно кнопку Duplicate доработать, если не окрасил написать - Дубликатов нет кнопка удаляет окончательно из столбца повторы но, почему то это делает очень долго, когда выбираешь весь столбец
Малость подправил.Wasilich
Ответить
Сообщение Цитата
можно кнопку Duplicate доработать, если не окрасил написать - Дубликатов нет кнопка удаляет окончательно из столбца повторы но, почему то это делает очень долго, когда выбираешь весь столбец
Малость подправил.Автор - Wasilich Дата добавления - 01.04.2016 в 11:50
next777
Дата: Пятница, 01.04.2016, 13:34 |
Сообщение № 6
Группа: Пользователи
Ранг: Новичок
Сообщений: 20
Репутация:
0
±
Замечаний:
20% ±
Excel 2013
Малость подправил. К сообщению приложен файл: next777.xls(88Kb)
Супер, спасибо вам
Малость подправил. К сообщению приложен файл: next777.xls(88Kb)
Супер, спасибо вамnext777
web-программист
Ответить
Сообщение Малость подправил. К сообщению приложен файл: next777.xls(88Kb)
Супер, спасибо вамАвтор - next777 Дата добавления - 01.04.2016 в 13:34
next777
Дата: Пятница, 01.04.2016, 14:21 |
Сообщение № 7
Группа: Пользователи
Ранг: Новичок
Сообщений: 20
Репутация:
0
±
Замечаний:
20% ±
Excel 2013
как сделать, чтобы шапку не окрашивало, т.е. не с 1 строки проверяло а с 2 по столбцу и ниже и кнопочка Remove удаляла только в своих столбцах, не сравнивала соседний столбец, когда выделаешь несколько столбцов удаляет как то странновато, так его логику удаления не смог понять,) по одному столбцу великолепно удаляет, а вот несколько непонятно удаляет
как сделать, чтобы шапку не окрашивало, т.е. не с 1 строки проверяло а с 2 по столбцу и ниже и кнопочка Remove удаляла только в своих столбцах, не сравнивала соседний столбец, когда выделаешь несколько столбцов удаляет как то странновато, так его логику удаления не смог понять,) по одному столбцу великолепно удаляет, а вот несколько непонятно удаляет next777
web-программист
Сообщение отредактировал next777 - Пятница, 01.04.2016, 14:36
Ответить
Сообщение как сделать, чтобы шапку не окрашивало, т.е. не с 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
спасибо, очень интересно работает была бы еще инфа в окошке, сколько удалил
К сообщению приложен файл: 4388127_my-my.xlsm
спасибо, очень интересно работает была бы еще инфа в окошке, сколько удалилnext777
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
а можно без сортировки, только на удаление дубликатов акцентировать? т.е убрать из кода сортировку, самому не получается изменить глючит когда окно всталяю сколько удалило
Здравствуйте! Что-то типа такого. 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
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
Группа: Пользователи
Ранг: Новичок
Сообщений: 38
Репутация:
8
±
Замечаний:
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]
Здравствуйте! Тут совсем просто;) [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
WM :Z116994103939
Сообщение отредактировал 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
Добавил вывод количества удаленных дублкатов по всем страницам
Спасибо за все, только вот пустоты тоже считает их нужно было отдельно как то просто удалены дубликат цифр не считая пустот
Добавил вывод количества удаленных дублкатов по всем страницам
Спасибо за все, только вот пустоты тоже считает их нужно было отдельно как то просто удалены дубликат цифр не считая пустотnext777
web-программист
Сообщение отредактировал next777 - Воскресенье, 03.04.2016, 06:15
Ответить
Сообщение Добавил вывод количества удаленных дублкатов по всем страницам
Спасибо за все, только вот пустоты тоже считает их нужно было отдельно как то просто удалены дубликат цифр не считая пустотАвтор - next777 Дата добавления - 03.04.2016 в 00:25