Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Excel
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 12.06.2018, 14:53   #31
IgorGO
Новичок
СтарожилДжуниор
 
Аватар для IgorGO
 
Регистрация: 05.02.2008
Сообщений: 9,487
По умолчанию

1. Приведенный выше макрос не останавлмваеися на первой пустой ячейке, а проходит по всех ячейках диапазона D5:F5 (по всех 3-х)
2. если Вы чуть подробнее расскажете при добавлении каких значений и куда добавлять "Смена", то обязательно найдутся люди, которые смогут Вам рассказать как это сделать
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете
IgorGO вне форума Ответить с цитированием
Старый 12.06.2018, 17:39   #32
autostavrroute
Пользователь
 
Регистрация: 07.06.2018
Сообщений: 40
По умолчанию

Код:
Sub Кнопка40_Щелчок()
'Смены
 Dim col As New Collection, c As Range, i&, k&

 For Each c In Sheets("График").Range("D5:F5").Cells
       If c.Value <> "" Then col.Add Trim(c) & "Смена"
       
 Next

 ReDim arr(0 To col.Count - 1)
 For i = 1 To col.Count: arr(i - 1) = col(i): Next
 Worksheets(arr).Select
End Sub
Вот так сделал, работает.
autostavrroute вне форума Ответить с цитированием
Старый 12.06.2018, 19:26   #33
autostavrroute
Пользователь
 
Регистрация: 07.06.2018
Сообщений: 40
По умолчанию

Цитата:
Сообщение от IgorGO Посмотреть сообщение
1. Приведенный выше макрос не останавлмваеися на первой пустой ячейке, а проходит по всех ячейках диапазона D5:F5 (по всех 3-х)
Да все верно. Тоже рабочий макрос. Спасибо
autostavrroute вне форума Ответить с цитированием
Старый 05.07.2018, 17:11   #34
autostavrroute
Пользователь
 
Регистрация: 07.06.2018
Сообщений: 40
По умолчанию

Код:
Sub Кнопка40_Щелчок()
'Смены
 Dim col As New Collection, c As Range, i&, k&
' For Each c In Sheets("График").Range("D5:BA5").Cells

 
For Each c In Sheets("График").Range("D5:BA5", "AF6:CA6").Cells

       If c.Value <> "" Then col.Add Trim(c) & "Смена"
       
 Next

 ReDim arr(0 To col.Count - 1)
 For i = 1 To col.Count: arr(i - 1) = col(i): Next
 Worksheets(arr).Select
End Sub
Хотел добавить обработку ячеек на другой строке, но не разберусь с массивом!
autostavrroute вне форума Ответить с цитированием
Старый 05.07.2018, 17:27   #35
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,238
По умолчанию

попробуйте так:


Код:
For Each c In Sheets("График").Range("D5:BA5,AF6:CA6").Cells

       If c.Value <> "" Then col.Add Trim(c) & "Смена"
       
 Next
Serge_Bliznykov вне форума Ответить с цитированием
Старый 04.10.2018, 17:07   #36
autostavrroute
Пользователь
 
Регистрация: 07.06.2018
Сообщений: 40
По умолчанию

Подскажите пожалуйста - как доработать чтобы листы не выделялись обработанные в этом алгоритме а скрывались?!
autostavrroute вне форума Ответить с цитированием
Старый 04.10.2018, 17:27   #37
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,238
По умолчанию

Цитата:
Сообщение от autostavrroute Посмотреть сообщение
Подскажите пожалуйста - как доработать чтобы листы не выделялись обработанные в этом алгоритме а скрывались?!
попробуйте заменить строчку
Цитата:
Код:
Worksheets(arr).Select
на
Код:
Worksheets(arr).Visible = xlSheetHidden
Serge_Bliznykov вне форума Ответить с цитированием
Старый 04.10.2018, 17:30   #38
autostavrroute
Пользователь
 
Регистрация: 07.06.2018
Сообщений: 40
По умолчанию

Цитата:
Сообщение от Serge_Bliznykov Посмотреть сообщение
попробуйте заменить строчку

на
Код:
Worksheets(arr).Visible = xlSheetHidden
Пробовал говорит так нельзя
autostavrroute вне форума Ответить с цитированием
Старый 04.10.2018, 18:04   #39
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,238
По умолчанию

так в цикле прячьте:
Код:
 Dim col As New Collection, c As Range, i&, k&
 
 For Each c In Sheets("График").Range("D5:BA5", "AF6:CA6").Cells

       If c.Value <> "" Then col.Add Trim(c) & "Смена"
       
 Next

 For i = 1 To col.Count:  Worksheets(col(i)).Visible = xlSheetHidden : Next
p.s. не проверял!
Serge_Bliznykov вне форума Ответить с цитированием
Старый 04.10.2018, 18:41   #40
autostavrroute
Пользователь
 
Регистрация: 07.06.2018
Сообщений: 40
По умолчанию

Цитата:
p.s. не проверял!
да тоже так уже решил пробовать, думал может как то от массива можно оттолкнуться.
autostavrroute вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
выделение нескрытых листов книги Jaroslav Microsoft Office Excel 4 27.05.2014 16:10
VBA - выделение группы листов Tihon Microsoft Office Excel 14 09.01.2013 20:46
Поиск по списку gavrylyuk Microsoft Office Excel 6 25.03.2010 16:24
Загрузка по списку jkpro Работа с сетью в Delphi 23 24.09.2009 17:26
выделение листов по условию Bronyk Microsoft Office Excel 5 11.03.2008 19:40