Обеспечить сортировку для всех листов Excel

@Golden777 · Регистрация: 03.03.2016

Студворк — интернет-сервис помощи студентам

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
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

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

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

@Hugo121 · 31.03.2016, 09:14

Когда в настройках сортировки указываете диапазон - нужно указать к какому листу этот диапазон принадлежит, сейчас будет обращение к активному листу.
И тогда должно работать на любом указанном листе.
Насчёт "выбрать столбец" не понял - что мешает его выбрать?

@Golden777 · 31.03.2016, 10:17 **[ТС]**

Hugo121, как в коде прописать действие пока не знаю, чтобы поочередно одним макросом столбцы сортировало как отдельную от B до M , вот файл

@Hugo121 · 31.03.2016, 10:42

Я пас, архивы недоступны.
Но думаю просто добавляете в код перебор названий листов.

toiai · 31.03.2016, 12:28

Как вариант:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
Sub Сортировка()
    Dim sh As Worksheet, i&
    Application.ScreenUpdating = False
    For Each sh In Sheets
        sh.Activate
        For i = 2 To 13
            With Columns(i)
                .Sort key1:=.Cells(1), Header:=xlYes
            End With
        Next
    Next
    Application.ScreenUpdating = True
End Sub

@Hugo121 · 31.03.2016, 12:32

Только полезно и перебирать не in sheets, а in worksheets - т.к. иногда бывает что попадаются листы-графики.
Ну или такой лист в любой момент может создать любой юзер из бухгалтерии...

@Golden777 · 31.03.2016, 12:39 **[ТС]**

Hugo121,

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
Sub Сортировка()
    Dim sh As Worksheet, i&
    Application.ScreenUpdating = False
    For Each sh In Worksheets
        sh.Activate
        For i = 2 To 13
            With Columns(i)
                .Sort key1:=.Cells(1), Header:=xlYes
            End With
        Next
    Next
    Application.ScreenUpdating = True
End Sub

Спасибо. очень круто)

Добавлено через 13 секунд
toiai, Замечательно

@Golden777 · 31.03.2016, 21:21 **[ТС]**

Hugo121, toiai,
Как соединить этот

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
Sub Сортировка()
    Dim sh As Worksheet, i&
    Application.ScreenUpdating = False
    For Each sh In Worksheets
        sh.Activate
        For i = 2 To 13
            With Columns(i)
                .Sort key1:=.Cells(1), Header:=xlYes
            End With
        Next
    Next
    Application.ScreenUpdating = True
End Sub

второе как добавить копирование данных из цветных ячеек на основе условного форматирования в пустой столбец E , соответственно I и M и тоже самое проделать на всех страницах если возможно (сортировка по цвету уже есть, для быстроты действий) осталось прописать в пустые

можно отдельно макрос такой

@Hugo121 · 31.03.2016, 22:15

Не понимаю - что с чем соединить? Какое копирование куда добавить?
Если нужно как-то копировать по состоянию УФ - "курите" DisplayFormat property:
https://msdn.microsoft.com/en-... 38814.aspx
Правда только как пишут Office 2013 and later (в 2010 как-то криво работает, а в 365 помнится работало вроде ОК)
Т.к. дома 2010 - не помогу.

@Golden777 · 31.03.2016, 22:27 **[ТС]**

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

Добавлено через 4 минуты
Hugo121, хотел так, чтобы из незакрашенных и цветных ячеек столбца с желтыми навверху в моем примере во вложении, отбирало именно желтые и вставляло эти цифры, в пустой столбец соседняя через две, можно копировать если не скопирует цвет не страшно, главное чтоб только с желтых, вставляло без цвета

@Hugo121 · 31.03.2016, 22:52

Сообщение от Golden777

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

- т.е. вместо сортировки по значению нужно сортировать сперва по цвету УФ? Можно записать рекордером и внедрить, если это то что нужно.
По второму вопросу - я уже сказал что я пас. Кстати Вы что-то не срагировали - а может быть не только я пас...

@Golden777 · 31.03.2016, 22:59 **[ТС]**

Hugo121, рекордером то записал, но только действует на один лист)

Добавлено через 1 минуту
Hugo121, я сделал так вашим кодом, а потом сортировка по цвету, но только лист с названием вышел

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
Sub Фильтр6()
    Columns("B:B").Select
    Selection.AutoFilter
    ActiveWorkbook.Worksheets("СУ6").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("СУ6").AutoFilter.Sort.SortFields.Add Key:=Range( _
        "B1:B148"), SortOn:=xlSortOnCellColor, Order:=xlAscending, DataOption:= _
        xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("СУ6").AutoFilter.Sort.SortFields(1).SortOnValue
        .Pattern = xlPatternRectangularGradient
        .Gradient.RectangleLeft = 0.5
        .Gradient.RectangleRight = 0.5
        .Gradient.RectangleTop = 0.5
        .Gradient.RectangleBottom = 0.5
        .Gradient.ColorStops.Clear
    End With
    With ActiveWorkbook.Worksheets("СУ6").AutoFilter.Sort.SortFields(1).SortOnValue _
        .Gradient.ColorStops.Add(0)
        .Color = 16777215
        .TintAndShade = 0
    End With
    With ActiveWorkbook.Worksheets("СУ6").AutoFilter.Sort.SortFields(1).SortOnValue _
        .Gradient.ColorStops.Add(1)
        .Color = 8125946
        .TintAndShade = 0
    End With
    With ActiveWorkbook.Worksheets("СУ6").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Columns("F:F").Select
    Selection.AutoFilter
    Selection.AutoFilter
    ActiveWorkbook.Worksheets("СУ6").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("СУ6").AutoFilter.Sort.SortFields.Add Key:=Range( _
        "F1:F148"), SortOn:=xlSortOnCellColor, Order:=xlAscending, DataOption:= _
        xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("СУ6").AutoFilter.Sort.SortFields(1).SortOnValue
        .Pattern = xlPatternRectangularGradient
        .Gradient.RectangleLeft = 0.5
        .Gradient.RectangleRight = 0.5
        .Gradient.RectangleTop = 0.5
        .Gradient.RectangleBottom = 0.5
        .Gradient.ColorStops.Clear
    End With
    With ActiveWorkbook.Worksheets("СУ6").AutoFilter.Sort.SortFields(1).SortOnValue _
        .Gradient.ColorStops.Add(0)
        .Color = 16777215
        .TintAndShade = 0
    End With
    With ActiveWorkbook.Worksheets("СУ6").AutoFilter.Sort.SortFields(1).SortOnValue _
        .Gradient.ColorStops.Add(1)
        .Color = 8125946
        .TintAndShade = 0
    End With
    With ActiveWorkbook.Worksheets("СУ6").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Columns("J:J").Select
    Selection.AutoFilter
    Selection.AutoFilter
    ActiveWorkbook.Worksheets("СУ6").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("СУ6").AutoFilter.Sort.SortFields.Add Key:=Range( _
        "J1:J148"), SortOn:=xlSortOnCellColor, Order:=xlAscending, DataOption:= _
        xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("СУ6").AutoFilter.Sort.SortFields(1).SortOnValue
        .Pattern = xlPatternRectangularGradient
        .Gradient.RectangleLeft = 0.5
        .Gradient.RectangleRight = 0.5
        .Gradient.RectangleTop = 0.5
        .Gradient.RectangleBottom = 0.5
        .Gradient.ColorStops.Clear
    End With
    With ActiveWorkbook.Worksheets("СУ6").AutoFilter.Sort.SortFields(1).SortOnValue _
        .Gradient.ColorStops.Add(0)
        .Color = 16777215
        .TintAndShade = 0
    End With
    With ActiveWorkbook.Worksheets("СУ6").AutoFilter.Sort.SortFields(1).SortOnValue _
        .Gradient.ColorStops.Add(1)
        .Color = 8125946
        .TintAndShade = 0
    End With
    With ActiveWorkbook.Worksheets("СУ6").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("O26").Select
    Selection.AutoFilter
End Sub

как сделать на все листы без понятия
в файле во вложении это можно увидеть прислан в 21:21 сегодня

Добавлено через 3 минуты
Hugo121, ладно будем считать это решенным, нам теперь эти желтые ячейки скопировать нужно в столбцы E, I, M вносить

вот здесь то я не знаю как, весь инет облазил и все не то нахожу

@Hugo121 · 31.03.2016, 23:02

Моего кода тут в теме ни строчки нет

Сообщение от Golden777

как сделать на все листы

- так ведь выше toiai показал как. Можете использовать объект sh (вместо ActiveWorkbook.Worksheets("СУ6")), можете строку sh.name (вместо "СУ6")

Добавлено через 1 минуту

Сообщение от Golden777

вот здесь то я не знаю как, весь инет облазил и все не то нахожу

я выше дал ссылку как можно их вычислить - но там же много и долго писал про ограничения... и что я пас.

@Golden777 · 01.04.2016, 09:06 **[ТС]**

Hugo121, для достижения нужного результата, вопрос данный может также решить
другой вариант фильтрация, пока в этом бессилен
в B есть цифры необходимо убрать цифры в нем из соседних двух, чтобы получить оставшиеся цифры
эти оставшиеся заполнить по столбцу в E
понятно что также нужно и для двух остальных I, M

Добавлено через 1 минуту

Сообщение от Hugo121

Только полезно и перебирать не in sheets, а in worksheets - т.к. иногда бывает что попадаются листы-графики.
Ну или такой лист в любой момент может создать любой юзер из бухгалтерии...

ну я за это, что ваша поправка была принята к сведению )

Добавлено через 10 часов 2 минуты
Hugo121, с массовой заменой цветных ячеек получилось, спасибо за подсказку)))
Вот это кодище)))

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
Sub Замена_в_сортировке()
    Dim sh As Worksheet, i&
    Application.ScreenUpdating = False
    For Each sh In Worksheets
        sh.Activate
        For i = 2 To 13
    Columns("B:B").Select
    Selection.AutoFilter
    sh.AutoFilter.Sort.SortFields.Clear
    sh.AutoFilter.Sort.SortFields.Add Key:=Range( _
        "B1:B148"), SortOn:=xlSortOnCellColor, Order:=xlAscending, DataOption:= _
        xlSortTextAsNumbers
    With sh.AutoFilter.Sort.SortFields(1).SortOnValue
        .Pattern = xlPatternRectangularGradient
        .Gradient.RectangleLeft = 0.5
        .Gradient.RectangleRight = 0.5
        .Gradient.RectangleTop = 0.5
        .Gradient.RectangleBottom = 0.5
        .Gradient.ColorStops.Clear
    End With
    With sh.AutoFilter.Sort.SortFields(1).SortOnValue _
        .Gradient.ColorStops.Add(0)
        .Color = 16777215
        .TintAndShade = 0
    End With
    With sh.AutoFilter.Sort.SortFields(1).SortOnValue _
        .Gradient.ColorStops.Add(1)
        .Color = 8125946
        .TintAndShade = 0
    End With
    With sh.AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Columns("F:F").Select
    Selection.AutoFilter
    Selection.AutoFilter
    sh.AutoFilter.Sort.SortFields.Clear
    sh.AutoFilter.Sort.SortFields.Add Key:=Range( _
        "F1:F148"), SortOn:=xlSortOnCellColor, Order:=xlAscending, DataOption:= _
        xlSortTextAsNumbers
    With sh.AutoFilter.Sort.SortFields(1).SortOnValue
        .Pattern = xlPatternRectangularGradient
        .Gradient.RectangleLeft = 0.5
        .Gradient.RectangleRight = 0.5
        .Gradient.RectangleTop = 0.5
        .Gradient.RectangleBottom = 0.5
        .Gradient.ColorStops.Clear
    End With
    With sh.AutoFilter.Sort.SortFields(1).SortOnValue _
        .Gradient.ColorStops.Add(0)
        .Color = 16777215
        .TintAndShade = 0
    End With
    With sh.AutoFilter.Sort.SortFields(1).SortOnValue _
        .Gradient.ColorStops.Add(1)
        .Color = 8125946
        .TintAndShade = 0
    End With
    With sh.AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Columns("J:J").Select
    Selection.AutoFilter
    Selection.AutoFilter
    sh.AutoFilter.Sort.SortFields.Clear
    sh.AutoFilter.Sort.SortFields.Add Key:=Range( _
        "J1:J148"), SortOn:=xlSortOnCellColor, Order:=xlAscending, DataOption:= _
        xlSortTextAsNumbers
    With sh.AutoFilter.Sort.SortFields(1).SortOnValue
        .Pattern = xlPatternRectangularGradient
        .Gradient.RectangleLeft = 0.5
        .Gradient.RectangleRight = 0.5
        .Gradient.RectangleTop = 0.5
        .Gradient.RectangleBottom = 0.5
        .Gradient.ColorStops.Clear
    End With
    With sh.AutoFilter.Sort.SortFields(1).SortOnValue _
        .Gradient.ColorStops.Add(0)
        .Color = 16777215
        .TintAndShade = 0
    End With
    With sh.AutoFilter.Sort.SortFields(1).SortOnValue _
        .Gradient.ColorStops.Add(1)
        .Color = 8125946
        .TintAndShade = 0
    End With
    With sh.AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("O26").Select
    Selection.AutoFilter
            Next
    Next
    Sheets("СУ1").Select
End Sub

Новые блоги и статьи Все статьи Все блоги /
Знаешь почему 90% людей редко бывают счастливыми? kumehtar 14.04.2026 Потому что они ждут. Ждут выходных, ждут отпуска, ждут удачного момента. . . а удачный момент так и не приходит.	Фиксация колонок в отчете СКД Maks 14.04.2026 Фиксация колонок в СКД отчета типа Таблица. Задача: зафиксировать три левых колонки в отчете. Процедура ПриКомпоновкеРезультата(ДокументРезультат, ДанныеРасшифровки, СтандартнаяОбработка) / / . . .	Настройки VS Code Loafer 13.04.2026 { "cmake. configureOnOpen": false, "diffEditor. ignoreTrimWhitespace": true, "editor. guides. bracketPairs": "active", "extensions. ignoreRecommendations": true, . . .	Оптимизация кода на разграничение прав доступа к элементам формы Maks 13.04.2026 Алгоритм из решения ниже реализован на нетиповом документе, разработанного в конфигурации КА2. Задачи, как таковой, поставлено не было, проделанное ниже исключительно моя инициатива. Было так:. . .
Контроль заполнения и очистка дат в зависимости от значения перечислений Maks 12.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "ПланированиеПерсонала", разработанного в конфигурации КА2. Задача: реализовать контроль корректности заполнения дат назначения. . .	Архитектура слоя интернета для сервера-слоя. Hrethgir 11.04.2026 В продолжение https:/ / www. cyberforum. ru/ blogs/ 223907/ 10860. html Знаешь что я подумал? Раз мы все источники пишем в голове ветки, то ничего не мешает добавить в голову такой источник, который сам. . .	Подстановка значения реквизита справочника в табличную часть документа Maks 10.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "ПланированиеПерсонала", разработанного в конфигурации КА2. Задача: при выборе сотрудника (справочник Сотрудники) в ТЧ документа. . .	Очистка реквизитов документа при копировании Maks 09.04.2026 Алгоритм из решения ниже применим как для типовых, так и для нетиповых документов на самых различных конфигурациях. Задача: при копировании документа очищать определенные реквизиты и табличную. . .

Обеспечить сортировку для всех листов Excel

Решение

Решение

@Hugo121 6998 / 2896 / 555 Регистрация: 19.10.2012 Сообщений: 8,804
	31.03.2016, 09:14
	Когда в настройках сортировки указываете диапазон - нужно указать к какому листу этот диапазон принадлежит, сейчас будет обращение к активному листу. И тогда должно работать на любом указанном листе. Насчёт "выбрать столбец" не понял - что мешает его выбрать? 1

@Hugo121 6998 / 2896 / 555 Регистрация: 19.10.2012 Сообщений: 8,804
	31.03.2016, 10:42
	Я пас, архивы недоступны. Но думаю просто добавляете в код перебор названий листов. 1

@Hugo121 6998 / 2896 / 555 Регистрация: 19.10.2012 Сообщений: 8,804
	31.03.2016, 12:32
	Сообщение было отмечено Golden777 как решение Решение Только полезно и перебирать не in sheets, а in worksheets - т.к. иногда бывает что попадаются листы-графики. Ну или такой лист в любой момент может создать любой юзер из бухгалтерии... 2

@Hugo121 6998 / 2896 / 555 Регистрация: 19.10.2012 Сообщений: 8,804
	31.03.2016, 22:15
	Не понимаю - что с чем соединить? Какое копирование куда добавить? Если нужно как-то копировать по состоянию УФ - "курите" DisplayFormat property: https://msdn.microsoft.com/en-... 38814.aspx Правда только как пишут Office 2013 and later (в 2010 как-то криво работает, а в 365 помнится работало вроде ОК) Т.к. дома 2010 - не помогу. 0

@Golden777 2 / 2 / 0 Регистрация: 03.03.2016 Сообщений: 326
	31.03.2016, 22:27 [ТС]
	Hugo121, к первому нужно сортировка по цвету добавить наверх, чтоб проще работать было с цветными ячейками Добавлено через 4 минуты Hugo121, хотел так, чтобы из незакрашенных и цветных ячеек столбца с желтыми навверху в моем примере во вложении, отбирало именно желтые и вставляло эти цифры, в пустой столбец соседняя через две, можно копировать если не скопирует цвет не страшно, главное чтоб только с желтых, вставляло без цвета 0