Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

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

 

= Мир MS Excel/Перебор несмежных листов книги - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Manyasha, SLAVICK, китин  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Перебор несмежных листов книги (Макросы/Sub)
Перебор несмежных листов книги
vzdorny Дата: Четверг, 08.08.2019, 19:37 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 21
Репутация: 0 ±
Замечаний: 0% ±

Excel 2003
Здравствуйте!
У меня есть однотипный код, который обрабатывает
первый и четвёртый листы в книге, перекрашивая ячейки в них
[vba]
Код

Dim x As Range
Dim s As String
s = Лист1.Name
    For Each x In ThisWorkbook.Worksheets(s).UsedRange
        If x.Interior.Color = vbRed Or x.Interior.Color = vbGreen Then x.Interior.Color = vbBlue
    Next
s = Лист4.Name
    For Each x In ThisWorkbook.Worksheets(s).UsedRange
        If x.Interior.Color = vbRed Or x.Interior.Color = vbGreen Then x.Interior.Color = vbBlue
    Next

[/vba]
Но что делать если мне нужно обрабатывать каждый третий лист, а их будет допустим 40?
Неужели необходимо плодить однотипные записи?
И желательно обращаться к листам по кодовому имени на случай если пользователь
решит их переименовать или переместить
То есть по здесь идее нужен цикл с шагом 3 от 1 до Workbooks(1).Sheets.Count
но работающий код мне написать не удалось, постоянно какие-то ошибки возникают :(
Есть идеи, как это реализовать?
Спасибо!
 
Ответить
СообщениеЗдравствуйте!
У меня есть однотипный код, который обрабатывает
первый и четвёртый листы в книге, перекрашивая ячейки в них
[vba]
Код

Dim x As Range
Dim s As String
s = Лист1.Name
    For Each x In ThisWorkbook.Worksheets(s).UsedRange
        If x.Interior.Color = vbRed Or x.Interior.Color = vbGreen Then x.Interior.Color = vbBlue
    Next
s = Лист4.Name
    For Each x In ThisWorkbook.Worksheets(s).UsedRange
        If x.Interior.Color = vbRed Or x.Interior.Color = vbGreen Then x.Interior.Color = vbBlue
    Next

[/vba]
Но что делать если мне нужно обрабатывать каждый третий лист, а их будет допустим 40?
Неужели необходимо плодить однотипные записи?
И желательно обращаться к листам по кодовому имени на случай если пользователь
решит их переименовать или переместить
То есть по здесь идее нужен цикл с шагом 3 от 1 до Workbooks(1).Sheets.Count
но работающий код мне написать не удалось, постоянно какие-то ошибки возникают :(
Есть идеи, как это реализовать?
Спасибо!

Автор - vzdorny
Дата добавления - 08.08.2019 в 19:37
nilem Дата: Четверг, 08.08.2019, 20:30 | Сообщение № 2
Группа: Авторы
Ранг: Старожил
Сообщений: 1519
Репутация: 528 ±
Замечаний: 0% ±

Excel 2013
vzdorny, привет
типа такого пойдет?
[vba]
Код
Sub ttt()
Dim i&
With ThisWorkbook
    For i = 1 To .Sheets.Count Step 3
        MsgBox .Sheets(i).Name
    Next i
End With
End Sub
[/vba]


Яндекс.Деньги 4100159601573
 
Ответить
Сообщениеvzdorny, привет
типа такого пойдет?
[vba]
Код
Sub ttt()
Dim i&
With ThisWorkbook
    For i = 1 To .Sheets.Count Step 3
        MsgBox .Sheets(i).Name
    Next i
End With
End Sub
[/vba]

Автор - nilem
Дата добавления - 08.08.2019 в 20:30
vzdorny Дата: Четверг, 08.08.2019, 22:01 | Сообщение № 3
Группа: Пользователи
Ранг: Новичок
Сообщений: 21
Репутация: 0 ±
Замечаний: 0% ±

Excel 2003
nilem, не совсем.
если я правильно понимаю, то в данном случае
обращение к листу происходит по его порядковому номеру,
который меняется, если его перетащить
(например, если в новой книге, состоящей из листов,
ярлычки которых расположены слева направо [Лист1, Лист2 и т.д.]
поменять местами ярлычки Лист1 и Лист2,
то Лист2 станет первым, а Лист1 вторым)


Сообщение отредактировал vzdorny - Четверг, 08.08.2019, 22:05
 
Ответить
Сообщениеnilem, не совсем.
если я правильно понимаю, то в данном случае
обращение к листу происходит по его порядковому номеру,
который меняется, если его перетащить
(например, если в новой книге, состоящей из листов,
ярлычки которых расположены слева направо [Лист1, Лист2 и т.д.]
поменять местами ярлычки Лист1 и Лист2,
то Лист2 станет первым, а Лист1 вторым)

Автор - vzdorny
Дата добавления - 08.08.2019 в 22:01
InExSu Дата: Пятница, 09.08.2019, 00:08 | Сообщение № 4
Группа: Проверенные
Ранг: Ветеран
Сообщений: 560
Репутация: 64 ±
Замечаний: 0% ±

Excel 2010
Привет!
обращение к листу происходит по его порядковому номеру,
который меняется, если его перетащить

Нет. Не меняется.


На сохранение второго закона термодинамики: яндекс.кошелёк 410012113235839
 
Ответить
СообщениеПривет!
обращение к листу происходит по его порядковому номеру,
который меняется, если его перетащить

Нет. Не меняется.

Автор - InExSu
Дата добавления - 09.08.2019 в 00:08
boa Дата: Пятница, 09.08.2019, 08:42 | Сообщение № 5
Группа: Проверенные
Ранг: Обитатель
Сообщений: 397
Репутация: 110 ±
Замечаний: 0% ±

2013, 365
Нет. Не меняется.

Меняется
[vba]
Код

Sub test()
Dim sh As Worksheet

For Each sh In Worksheets
    Debug.Print sh.Name; sh.Index
Next

    Sheets(2).Move Before:=Sheets(1)

For Each sh In Worksheets
    Debug.Print sh.Name; sh.Index
Next

End Sub
[/vba]




Сообщение отредактировал boa - Пятница, 09.08.2019, 08:48
 
Ответить
Сообщение
Нет. Не меняется.

Меняется
[vba]
Код

Sub test()
Dim sh As Worksheet

For Each sh In Worksheets
    Debug.Print sh.Name; sh.Index
Next

    Sheets(2).Move Before:=Sheets(1)

For Each sh In Worksheets
    Debug.Print sh.Name; sh.Index
Next

End Sub
[/vba]

Автор - boa
Дата добавления - 09.08.2019 в 08:42
_Boroda_ Дата: Пятница, 09.08.2019, 10:14 | Сообщение № 6
Группа: Модераторы
Ранг: Местный житель
Сообщений: 15572
Репутация: 6075 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Такой вариант (с учетом того, что кодовые имена не переименовывались)
[vba]
Код
Sub tt()
    scn_ = Sheets(1).CodeName
    For i = 1 To Len(scn_)
        If IsNumeric(Mid(scn_, i, 1)) Then
            tcn_ = Left(scn_, i - 1)
            Exit For
        End If
    Next i
    For i = 1 To Sheets.Count
        If Replace(Sheets(i).CodeName, tcn_, "") Mod 3 = 1 Then
            For Each x_ In Sheets(i).UsedRange
                With x_
                    ic_ = .Interior.Color
                    If ic_ = vbRed Or ic_ = vbGreen Then
                        .Interior.Color = vbBlue
                    End If
                End With
            Next
        End If
    Next i
    MsgBox "Всё"
End Sub
[/vba]

* Немного переписал и файл перевложил
К сообщению приложен файл: 186852_1.xlsm(23.8 Kb)


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995


Сообщение отредактировал _Boroda_ - Пятница, 09.08.2019, 11:08
 
Ответить
СообщениеТакой вариант (с учетом того, что кодовые имена не переименовывались)
[vba]
Код
Sub tt()
    scn_ = Sheets(1).CodeName
    For i = 1 To Len(scn_)
        If IsNumeric(Mid(scn_, i, 1)) Then
            tcn_ = Left(scn_, i - 1)
            Exit For
        End If
    Next i
    For i = 1 To Sheets.Count
        If Replace(Sheets(i).CodeName, tcn_, "") Mod 3 = 1 Then
            For Each x_ In Sheets(i).UsedRange
                With x_
                    ic_ = .Interior.Color
                    If ic_ = vbRed Or ic_ = vbGreen Then
                        .Interior.Color = vbBlue
                    End If
                End With
            Next
        End If
    Next i
    MsgBox "Всё"
End Sub
[/vba]

* Немного переписал и файл перевложил

Автор - _Boroda_
Дата добавления - 09.08.2019 в 10:14
InExSu Дата: Пятница, 09.08.2019, 10:53 | Сообщение № 7
Группа: Проверенные
Ранг: Ветеран
Сообщений: 560
Репутация: 64 ±
Замечаний: 0% ±

Excel 2010
Меняется

Да. Спасибо. Был неправ.


На сохранение второго закона термодинамики: яндекс.кошелёк 410012113235839
 
Ответить
Сообщение
Меняется

Да. Спасибо. Был неправ.

Автор - InExSu
Дата добавления - 09.08.2019 в 10:53
vzdorny Дата: Суббота, 10.08.2019, 11:35 | Сообщение № 8
Группа: Пользователи
Ранг: Новичок
Сообщений: 21
Репутация: 0 ±
Замечаний: 0% ±

Excel 2003
_Boroda_, спасибо, помогло!
Благодарю всех за ответы!
 
Ответить
Сообщение_Boroda_, спасибо, помогло!
Благодарю всех за ответы!

Автор - vzdorny
Дата добавления - 10.08.2019 в 11:35
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Перебор несмежных листов книги (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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