ReSQL.ru
     
powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Мобильная версия    Контакт    Правила    FAQ    Помощь
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Цикл по листам: усложненный вариант
6 сообщений из 6, страница 1 из 1
Цикл по листам: усложненный вариант
    #34992826
Vk009
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Vk009
Гость
Здавствуйте!
Прошу помощи в решении следующей задачи:
Есть n-количество листов, первый лист называется условно "Лист1". Он выполняет роль списка. На каждом листе выполняется один и тот же "макрос1" по копированию диапазона с этого листа на "Лист1".
Проблема: запись макроса, создающего цикл со второго и до последнего листа с выполнением на каждом листе "макроса1". Сложность для меня в том, что "макрос1" активирует "Лист1", когда вставляет в него дипазон.
Просмотрел все страницы, выданные Yandexом, форум. Встречаются только циклы с перебором всех листов. Очень не хочется делать на абсолютных ссылках, тем более что число листов заранее неизвестно. Спасибо всем, кто сможет помочь.
...
Рейтинг: 0 / 0
06.12.2007, 22:43
| Ответить | Цитировать | Написать  
Цикл по листам: усложненный вариант
    #34992890
lena_###
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
lena_###
Гость
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
Sub s()
  Dim n As Long
  For n =  1  To ThisWorkbook.Worksheets.Count
    If ThisWorkbook.Worksheets(n).Name <> "Лист1" Then
      'что-то делаем, например:
      Debug.Print ThisWorkbook.Worksheets(n).Name
    End If
  Next n
End Sub
...
Рейтинг: 0 / 0
06.12.2007, 23:53
| Ответить | Цитировать | Написать  
Цикл по листам: усложненный вариант
    #34992922
Vk009
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Vk009
Гость
Спасибо за отклмк! У меня в таком случае зацикливается на одном и том же листе.
Нашел вот так макрос (by Nosorog - спасибо огромное)

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
Sub Nosorog()
Const result_sheet = "Лист1"
Dim ws As Worksheet
 With Sheets(result_sheet)               'меньше писанины ;)
.Range("A2") = ("A1")              'для корректной работы .end(xldown)
For Each ws In Worksheets               'цикл по листам
    If ws.Name <> result_sheet Then     'для всех кроме первого
                                        'если первая ячейка листа не пустая, копируем текущую
                                        'область в первую свободную ячейку листа результата
        If ws.Range("b2") <> "" Then _
            ws.Range("B2:L63").Copy .Range("A1").End(xlDown).Offset( 1 ,  0 )
            ws.Range("M2:W63").Copy .Range("A1").End(xlDown).Offset( 1 ,  0 )
            ws.Range("X2:AH63").Copy .Range("A1").End(xlDown).Offset( 1 ,  0 )
            ws.Range("AI2:AS63").Copy .Range("A1").End(xlDown).Offset( 1 ,  0 )
            ws.Range("AT2:BD63").Copy .Range("A1").End(xlDown).Offset( 1 ,  0 )
            ws.Range("BE2:BO63").Copy .Range("A1").End(xlDown).Offset( 1 ,  0 )
    End If
                                  
Next
Range("K3:K100").Select    'Выбор области
Rng = Selection.Rows.Count 'Подсчет строк в выбранной области
ActiveCell.Offset( 0 ,  0 ).Select
For i =  1  To Rng            'Цикл
If ActiveCell.Value = "" Then
Selection.EntireRow.Delete 'непосредственно удаление
Else
ActiveCell.Offset( 1 ,  0 ).Select
End If
Next i                                  'следующий

End With
End Sub
Все замечательно, только вот выбрать в последнем столбце "К:К" массив идентичный CurrentRegion никак не могу. Будем искать. Еще раз всем спасибо.
...
Рейтинг: 0 / 0
07.12.2007, 00:51
| Ответить | Цитировать | Написать  
Цикл по листам: усложненный вариант
    #34992959
lena_###
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
lena_###
Гость
Попробуйте Intersect метод:

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
  Dim v_Sh As Worksheet, v_Rng As Range
  Set v_Sh = Worksheets("Лист1")
  v_Sh.Activate
  Set v_Rng = Intersect(v_Sh.Range("A1").CurrentRegion.EntireRow, v_Sh.Columns("K:K"))
  
  v_Rng.Select
  Debug.Print v_Rng.Address
...
Рейтинг: 0 / 0
07.12.2007, 02:15
| Ответить | Цитировать | Написать  
Цикл по листам: усложненный вариант
    #34992961
lena_###
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
lena_###
Гость
Код: plaintext
ActiveCell.Offset( 0 ,  0 ).Select
это круто
...
Рейтинг: 0 / 0
07.12.2007, 02:18
| Ответить | Цитировать | Написать  
Цикл по листам: усложненный вариант
    #34992965
Vk009
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Vk009
Гость
:) Самому смешно. Это называется: "Так было, а я не стал исправлять". Бездумное копирование. Lena###, Почему то в Вашем коде не получилось объявить переменную v_Rng, "Statement invalid outside Type block". Но я уже в давался, потому что сделал по-своему. В конечном итоге получился вот такой лист:
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
Sub Proekt()

Const result_sheet = "Лист1"
Dim ws As Worksheet
With Sheets(result_sheet)               '
.Range("A2:K2") = Range("A1:K1").Value  'для корректной работы .end(xldown)
For Each ws In Worksheets               'цикл по листам
    If ws.Name <> result_sheet Then     'для всех кроме "Лист1"
        If ws.Range("b2") <> "" Then _
            ws.Range("B2:L63").Copy .Range("A1").End(xlDown).Offset( 1 ,  0 ) ' копирование
            ws.Range("M2:W63").Copy .Range("A1").End(xlDown).Offset( 1 ,  0 ) ' и вставка диапазона
            ws.Range("X2:AH63").Copy .Range("A1").End(xlDown).Offset( 1 ,  0 )
            ws.Range("AI2:AS63").Copy .Range("A1").End(xlDown).Offset( 1 ,  0 )
            ws.Range("AT2:BD63").Copy .Range("A1").End(xlDown).Offset( 1 ,  0 )
            ws.Range("BE2:BO63").Copy .Range("A1").End(xlDown).Offset( 1 ,  0 )
    End If
Next
.Rows( 2 ).Delete                         ' Удаление ненужной строки
Dim m As Long
Range("K:K").Select                     'Выбор области
Rng = Range("K65536").End(xlUp).Row +  1  'Определение нижней ячейки со значением
For i =  1  To Rng                        'Цикл
If ActiveCell.Value = "" Then           'Найдена пустая ячейка
Selection.EntireRow.Delete              'Непосредственно удаление
Else
ActiveCell.Offset( 1 ,  0 ).Select
End If
Next i                                  'следующий
End With
For Each ws In Worksheets               'цикл по листам
    If ws.Name <> result_sheet Then     'для всех кроме первого
ws.Range("B2:BO63").SpecialCells(xlCellTypeConstants).Delete ' Удаление констант с листа
    End If
Next
End Sub

Голова больше не думает. Lena###, огромное спасибо за помощь! И спасибо за замечания.
...
Рейтинг: 0 / 0
07.12.2007, 02:42
| Ответить | Цитировать | Написать  
6 сообщений из 6, страница 1 из 1
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Цикл по листам: усложненный вариант
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение   Полит. конфиден.  
NoSQL.ru       Кролег: Проекты, Новости, Чат       РЕД ФОРУМ       Фотоальбом: Участники, Встречи
Закрыть
start [/forum/topic.php?fid=60&msg=34992922&tid=2162981]:
 0ms
get settings:
 10ms
get forum list:
 20ms
check forum access:
 4ms
check topic access:
 4ms
track hit:
 88ms
get topic data:
 12ms
get forum data:
 3ms
get page messages:
 39ms
get tp. blocked users:
 1ms
others: 243ms
total:  424ms
созд. / загр.: 424ms
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]