Форум программистов
 
Контакты: о проблемах с регистрацией, почтой и по другим вопросам пишите сюда - alarforum@yandex.ru, проверяйте папку спам! Обязательно пройдите активизацию e-mail.

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

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

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

Цитата:
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, 12:35   #22
Aleksandr H.
2 the Nation Glory
Профессионал
 
Аватар для Aleksandr H.
 
Регистрация: 27.05.2014
Адрес: Wild West Ukraine
Сообщений: 2,368
Репутация: 874

skype: aleksandr.gryb
По умолчанию

так разве последний елемент col не
Код:

col(col.Count-1)

?
__________________
Mailto: media.project@ukr.net
Aleksandr H. вне форума   Ответить с цитированием
Старый 12.06.2018, 12:47   #23
autostavrroute
Пользователь
 
Регистрация: 07.06.2018
Сообщений: 17
Репутация: 10
По умолчанию

Цитата:
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 в 13:05.
autostavrroute вне форума   Ответить с цитированием
Старый 12.06.2018, 13:05   #24
IgorGO
МегаМодератор
СуперМодератор
 
Аватар для IgorGO
 
Регистрация: 05.02.2008
Адрес: УКРАЇНА, Київ
Сообщений: 8,909
Репутация: 1648

icq: 7934250
skype: i2x0,5
По умолчанию

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

skype: aleksandr.gryb
По умолчанию

Код:

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

__________________
Mailto: media.project@ukr.net
Aleksandr H. вне форума   Ответить с цитированием
Старый 12.06.2018, 13:13   #26
autostavrroute
Пользователь
 
Регистрация: 07.06.2018
Сообщений: 17
Репутация: 10
По умолчанию

Цитата:
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, 13:14   #27
Aleksandr H.
2 the Nation Glory
Профессионал
 
Аватар для Aleksandr H.
 
Регистрация: 27.05.2014
Адрес: Wild West Ukraine
Сообщений: 2,368
Репутация: 874

skype: aleksandr.gryb
По умолчанию

Код:

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

__________________
Mailto: media.project@ukr.net
Aleksandr H. вне форума   Ответить с цитированием
Старый 12.06.2018, 13:23   #28
autostavrroute
Пользователь
 
Регистрация: 07.06.2018
Сообщений: 17
Репутация: 10
По умолчанию

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

Цитата:
Сообщение от 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, 14:42   #30
autostavrroute
Пользователь
 
Регистрация: 07.06.2018
Сообщений: 17
Репутация: 10
По умолчанию

Подскажите как до добавлении значения в массив добавить текст например "Смена".
Чтобы вместо Форд, Ларгус ... Пежо = было ФордСмена, ЛаргусСмена ... ПежоСмена
autostavrroute вне форума   Ответить с цитированием
Ответ

Опции темы

Ваши права в разделе
Вы не можете создавать новые темы
Вы не можете отвечать в темах
Вы не можете прикреплять вложения
Вы не можете редактировать свои сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.

Быстрый переход

Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
выделение нескрытых листов книги 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 17:24
Загрузка по списку jkpro Работа с сетью в Delphi 23 24.09.2009 17:26
выделение листов по условию Bronyk Microsoft Office Excel 5 11.03.2008 20:40


19:41.


Powered by vBulletin® Version 3.8.8 Beta 2
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.

RusProfile.ru


Справочник российских юридических лиц и организаций.
Проекты отопления, пеллетные котлы, бойлеры, радиаторы
интернет магазин respective.ru