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

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

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

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 12.06.2018, 11:13   #21
autostavrroute
Пользователь
 
Регистрация: 07.06.2018
Сообщений: 40
По умолчанию

Цитата:
Private Sub Кнопка37_Щелчок()

Dim col As New Collection, c As Range, i&

For i = 4 To 17
If Not Sheets("График").Cells(5, i).Value = "" Then col.Add Trim(i)
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
Оттолкнувшийся от рабочего последнего варианта я исправил на этот, но он выдает ошибку массива -9
autostavrroute вне форума Ответить с цитированием
Старый 12.06.2018, 11:35   #22
Aleksandr H.
2 the Nation Glory
Старожил
 
Аватар для Aleksandr H.
 
Регистрация: 27.05.2014
Сообщений: 3,289
По умолчанию

так разве последний елемент col не
Код:
col(col.Count-1)
?
Кто умер, но не забыт, тот бессмертен.
Лао-Цзы.
Aleksandr H. вне форума Ответить с цитированием
Старый 12.06.2018, 11:47   #23
autostavrroute
Пользователь
 
Регистрация: 07.06.2018
Сообщений: 40
По умолчанию

Цитата:
Sub SelectSheetsByRange()
Dim col As New Collection, c As Range, i&
For Each c In Sheets("График").Range("D5:F5").Cel ls
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
Этот вариант делает все корректно - одно но - если в перечисленной ячейке списка листов ("D5:F5") бедет пустая ячейка - происходит вылет по ошибке = надо как то доработать обработку при наличии пустой ячейки чтобы он ее пропускал.

Последний раз редактировалось autostavrroute; 12.06.2018 в 12:05.
autostavrroute вне форума Ответить с цитированием
Старый 12.06.2018, 12:05   #24
IgorGO
Новичок
СтарожилДжуниор
 
Аватар для IgorGO
 
Регистрация: 05.02.2008
Сообщений: 9,487
По умолчанию

при обращении к элементам коллекции по индексу: первый элемент коллекции имеет индекс 1, последний = количеству элементов в коллекции.
В Worksheets, Workbooks начинаются с 1-го элемента до Соunt, а не с 0-го и до Соunt-1
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете
IgorGO вне форума Ответить с цитированием
Старый 12.06.2018, 12:08   #25
Aleksandr H.
2 the Nation Glory
Старожил
 
Аватар для Aleksandr H.
 
Регистрация: 27.05.2014
Сообщений: 3,289
По умолчанию

Код:
Sub SelectSheetsByRange()
Dim col As New Collection, c As Range, i&
    For Each c In Sheets("График").Range("D5:F5").Cells
        If Trim(c) <> "" 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
Кто умер, но не забыт, тот бессмертен.
Лао-Цзы.
Aleksandr H. вне форума Ответить с цитированием
Старый 12.06.2018, 12:13   #26
autostavrroute
Пользователь
 
Регистрация: 07.06.2018
Сообщений: 40
По умолчанию

Цитата:
Private Sub Кнопка37_Щелчок()

Dim col As New Collection, c As Range, i&

For Each c In Sheets("График").Range("D5:Z5").Cel ls
If c.Value <> 0 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, 12:14   #27
Aleksandr H.
2 the Nation Glory
Старожил
 
Аватар для Aleksandr H.
 
Регистрация: 27.05.2014
Сообщений: 3,289
По умолчанию

Код:
Sub SelectSheetsByRange()
Dim arr()
Dim c As Range, i&
i = -1
    For Each c In Sheets("График").Range("D5:F5").Cells
        If Trim(c) <> "" Then
          i = i + 1
            ReDim Preserve arr(i)
            arr(i) = Trim(c)
        End If
    Next
Worksheets(arr).Select
End Sub
Кто умер, но не забыт, тот бессмертен.
Лао-Цзы.
Aleksandr H. вне форума Ответить с цитированием
Старый 12.06.2018, 12:23   #28
autostavrroute
Пользователь
 
Регистрация: 07.06.2018
Сообщений: 40
По умолчанию

Большое спасибо.
autostavrroute вне форума Ответить с цитированием
Старый 12.06.2018, 12:32   #29
autostavrroute
Пользователь
 
Регистрация: 07.06.2018
Сообщений: 40
По умолчанию

Цитата:
Сообщение от Aleksandr H. Посмотреть сообщение
Sub SelectSheetsByRange()
Dim arr()
Dim c As Range, i&
i = -1
For Each c In Sheets("График").Range("D5:F5").Cel ls
If Trim(c) <> "" Then
i = i + 1
ReDim Preserve arr(i)
arr(i) = Trim(c)
End If
Next
Worksheets(arr).Select
End Sub
Этот вариант доходит до первой пустой ячейке и другие листы не выделяет.
autostavrroute вне форума Ответить с цитированием
Старый 12.06.2018, 13:42   #30
autostavrroute
Пользователь
 
Регистрация: 07.06.2018
Сообщений: 40
По умолчанию

Подскажите как до добавлении значения в массив добавить текст например "Смена".
Чтобы вместо Форд, Ларгус ... Пежо = было ФордСмена, ЛаргусСмена ... ПежоСмена
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