Возможно ли оптимизировать код? - Мир MS Excel

Регистрация

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

= Мир MS Excel/Возможно ли оптимизировать код? - Мир MS Excel

Страница 1 из 1 1
Модератор форума: китин, _Boroda_, DrMini

Возможно ли оптимизировать код? (Макросы/Sub)

Возможно ли оптимизировать код?

Дата: Воскресенье, 29.11.2015, 14:02 | Сообщение № 1

Группа: Проверенные

Ранг: Обитатель

Сообщений: 282

Репутация: 19 ±

Замечаний: 0% ±

2007, 2010, 2013

Всем доброго дня.
На листе 8 диаграмм. По щелчку на диаграмме записал код фильтрации кроме нуля в таблице "Столбец1" и сортировки по возрастанию по столбцам - условно назову "Предметы" для улучшенного восприятия диаграмм.
[vba]

Код

Sub Диаграмма13_Щелчок()
Application.ScreenUpdating = False
ActiveSheet.ListObjects("Таблица1").Range.AutoFilter Field:=1, Criteria1:= _
"<>0", Operator:=xlAnd
ActiveWorkbook.Worksheets("Комп1").ListObjects("Таблица1").Sort.SortFields. _
Clear
ActiveWorkbook.Worksheets("Комп1").ListObjects("Таблица1").Sort.SortFields.Add _
Key:=Range("Таблица1[[#Headers],[#Data],[Итого средняя оценка]]"), SortOn:= _
xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("Комп1").ListObjects("Таблица1").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Application.ScreenUpdating = True
End Sub

[/vba]

Распространил код на все 8 диаграмм. (смотрим вложение)
Не устраивает то, что при наличии лишь двух переменных в строке "Sub Диаграмма13_Щелчок()" - (Диаграмма13-20) и
"Key:=Range("Таблица1[[#Headers],[#Data],[Итого средняя оценка]]"), SortOn:= _" - (меняются названия столбцов) пришлось создать практически одинаковых восемь блоков.
1. Возможно ли как то оптимизировать код? Так как реальный файл содержит куда более больше диаграмм на разных листах и хотелось бы применить макрос на все.
2. Возможен ли код автоматического изменения высоты диаграмм при увеличении количества строк не равных 0 в таблице? Количество строк постоянно меняется как в большую сторону так и в меньшую. При большом количестве строк диаграмма при установленной высоте становится мелковата и сложна к пониманию.
3. Как сделать чтобы диаграммы при увеличении высоты не перекрывали друг друга?
4. Хотелось бы добавить что бы по щелчку на диаграмме она копировалась в буфер обмена для вставки в файл отчета и появлялось сообщение что "Диаграмма скопирована в буфер обмена".

ЗЫ: Файл абсолютно абстрактен - вымысел, любые совпадения прошу считать случайностью)

Всем доброго дня.
На листе 8 диаграмм. По щелчку на диаграмме записал код фильтрации кроме нуля в таблице "Столбец1" и сортировки по возрастанию по столбцам - условно назову "Предметы" для улучшенного восприятия диаграмм.
[vba]

Код

Sub Диаграмма13_Щелчок()
Application.ScreenUpdating = False
ActiveSheet.ListObjects("Таблица1").Range.AutoFilter Field:=1, Criteria1:= _
"<>0", Operator:=xlAnd
ActiveWorkbook.Worksheets("Комп1").ListObjects("Таблица1").Sort.SortFields. _
Clear
ActiveWorkbook.Worksheets("Комп1").ListObjects("Таблица1").Sort.SortFields.Add _
Key:=Range("Таблица1[[#Headers],[#Data],[Итого средняя оценка]]"), SortOn:= _
xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("Комп1").ListObjects("Таблица1").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Application.ScreenUpdating = True
End Sub

[/vba]

Распространил код на все 8 диаграмм. (смотрим вложение)
Не устраивает то, что при наличии лишь двух переменных в строке "Sub Диаграмма13_Щелчок()" - (Диаграмма13-20) и
"Key:=Range("Таблица1[[#Headers],[#Data],[Итого средняя оценка]]"), SortOn:= _" - (меняются названия столбцов) пришлось создать практически одинаковых восемь блоков.
1. Возможно ли как то оптимизировать код? Так как реальный файл содержит куда более больше диаграмм на разных листах и хотелось бы применить макрос на все.
2. Возможен ли код автоматического изменения высоты диаграмм при увеличении количества строк не равных 0 в таблице? Количество строк постоянно меняется как в большую сторону так и в меньшую. При большом количестве строк диаграмма при установленной высоте становится мелковата и сложна к пониманию.
3. Как сделать чтобы диаграммы при увеличении высоты не перекрывали друг друга?
4. Хотелось бы добавить что бы по щелчку на диаграмме она копировалась в буфер обмена для вставки в файл отчета и появлялось сообщение что "Диаграмма скопирована в буфер обмена".

ЗЫ: Файл абсолютно абстрактен - вымысел, любые совпадения прошу считать случайностью)Sancho

К сообщению приложен файл: 0641639.xlsm (58.0 Kb)

Сообщение отредактировал Sancho - Воскресенье, 29.11.2015, 14:04

Ответить

СообщениеВсем доброго дня.
На листе 8 диаграмм. По щелчку на диаграмме записал код фильтрации кроме нуля в таблице "Столбец1" и сортировки по возрастанию по столбцам - условно назову "Предметы" для улучшенного восприятия диаграмм.
[vba]

Код

Sub Диаграмма13_Щелчок()
Application.ScreenUpdating = False
ActiveSheet.ListObjects("Таблица1").Range.AutoFilter Field:=1, Criteria1:= _
"<>0", Operator:=xlAnd
ActiveWorkbook.Worksheets("Комп1").ListObjects("Таблица1").Sort.SortFields. _
Clear
ActiveWorkbook.Worksheets("Комп1").ListObjects("Таблица1").Sort.SortFields.Add _
Key:=Range("Таблица1[[#Headers],[#Data],[Итого средняя оценка]]"), SortOn:= _
xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("Комп1").ListObjects("Таблица1").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Application.ScreenUpdating = True
End Sub

[/vba]

Распространил код на все 8 диаграмм. (смотрим вложение)
Не устраивает то, что при наличии лишь двух переменных в строке "Sub Диаграмма13_Щелчок()" - (Диаграмма13-20) и
"Key:=Range("Таблица1[[#Headers],[#Data],[Итого средняя оценка]]"), SortOn:= _" - (меняются названия столбцов) пришлось создать практически одинаковых восемь блоков.
1. Возможно ли как то оптимизировать код? Так как реальный файл содержит куда более больше диаграмм на разных листах и хотелось бы применить макрос на все.
2. Возможен ли код автоматического изменения высоты диаграмм при увеличении количества строк не равных 0 в таблице? Количество строк постоянно меняется как в большую сторону так и в меньшую. При большом количестве строк диаграмма при установленной высоте становится мелковата и сложна к пониманию.
3. Как сделать чтобы диаграммы при увеличении высоты не перекрывали друг друга?
4. Хотелось бы добавить что бы по щелчку на диаграмме она копировалась в буфер обмена для вставки в файл отчета и появлялось сообщение что "Диаграмма скопирована в буфер обмена".

ЗЫ: Файл абсолютно абстрактен - вымысел, любые совпадения прошу считать случайностью)

Автор - Sancho
Дата добавления - 29.11.2015 в 14:02

Дата: Вторник, 01.12.2015, 09:43 | Сообщение № 2

Группа: Проверенные

Ранг: Обитатель

Сообщений: 282

Репутация: 19 ±

Замечаний: 0% ±

2007, 2010, 2013

Оптимизация невозможна? :'(

:'(

Ответить

Дата: Вторник, 01.12.2015, 19:43 | Сообщение № 3

Группа: Проверенные

Ранг: Старожил

Сообщений: 1342

Репутация: 535 ±

Замечаний: 0% ±

Excel

Сделал только часть Вашего задания, а именно, чтобы не делать 8 одинаковых блоков. Сделал двумя способами - выберите, какой Вам больше подойдет.
В обоих способах сделал для двух диаграмм (Средняя оценка и Средняя оценка по Математике), по такому же принципу сделайте для остальных.
В способе 1 и так все видно (если посмотрите макрос), поэтому не буду его описывать.
По поводу способа 2. Можно задать диаграммам такие же имена, как заголовки таблицы. Я задал двум диаграммам имена "Итого средняя оценка" и "Математика". Дальше смотрите макрос.

К сообщению приложен файл: macros.zip (95.0 Kb)

Сообщение отредактировал Karataev - Вторник, 01.12.2015, 20:07

Ответить

Дата: Среда, 02.12.2015, 21:08 | Сообщение № 4

Группа: Проверенные

Ранг: Обитатель

Сообщений: 282

Репутация: 19 ±

Замечаний: 0% ±

2007, 2010, 2013

Цитата Karataev, 01.12.2015 в 19:43, в сообщении № 3

Сделал только часть Вашего задания

Спасибо большое, и этого вполне достаточно, остальные пункты шли как сопутствующий факультатив. пункт 4 отпал после разговора с руководителем - "тогда коллеги совсем обленятся, пускай хоть копи/пастают"

Цитата Karataev, 01.12.2015 в 19:43, в сообщении № 3

По поводу способа 2. Можно задать диаграммам такие же имена, как заголовки таблицы. Я задал двум диаграммам имена "Итого средняя оценка" и "Математика". Дальше смотрите макрос.

с первым вариантом все ясно, СПАСИБО! со вторым немного протупил пока не догадался переназначить на новый Ваш макрос. все искал решения как удалить недействующую ссылку на удаленный макрос. Кстати как? Если вдруг возникнет необходимость удалить макросы, не удалять же объекты?
Еще раз ОГРОМНОЕ СПАСИБО ЗА ВАШ ТРУД! hands

hands

Ответить

Дата: Среда, 02.12.2015, 21:13 | Сообщение № 5

Группа: Проверенные

Ранг: Старожил

Сообщений: 1342

Репутация: 535 ±

Замечаний: 0% ±

Excel

Цитата Sancho, 02.12.2015 в 21:08, в сообщении № 4

все искал решения как удалить недействующую ссылку на удаленный макрос. Кстати как?

а где Вы видите эту ссылку?

Ответить

Дата: Среда, 02.12.2015, 21:35 | Сообщение № 6

Группа: Проверенные

Ранг: Обитатель

Сообщений: 282

Репутация: 19 ±

Замечаний: 0% ±

2007, 2010, 2013

Ну когда на остальные диаграммы кликаешь эксель выдает предупреждение что не удается выполнить макрос Диаграмма18_Щелчок - тот макрос, что был в моем варианте

Сообщение отредактировал Sancho - Среда, 02.12.2015, 21:40

Ответить

Дата: Среда, 02.12.2015, 21:38 | Сообщение № 7

Группа: Проверенные

Ранг: Старожил

Сообщений: 1342

Репутация: 535 ±

Замечаний: 0% ±

Excel

Может так: щелкаете правой мышью по диаграмме - Назначить макрос - в поле "Имя макроса" удаляете - OK.
Правда, если потом снова открыть это диалоговое окно, то в поле будет имя макроса.

Ответить

Дата: Среда, 02.12.2015, 21:46 | Сообщение № 8

Группа: Проверенные

Ранг: Обитатель

Сообщений: 282

Репутация: 19 ±

Замечаний: 0% ±

2007, 2010, 2013

в том то и дело, что даже назначив новый макрос, а затем его удалив ссылка на макрос в объекте остается.

Ответить

Возможно ли оптимизировать код? (Макросы/Sub)

Страница 1 из 1
1

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