Цикл по листам: усложненный вариант / Visual Basic

ReSQL.ru

Мобильная версия Контакт Правила FAQ Помощь

Гость

Войти | Регистрация | Профиль | Очистить

Новые сообщения | Избранное

Форумы | Пользователи | Статистика | Мод. лог | Поиск

Цитировать

Написать

Автор*:

Ввести пароль для входа

Тема*:

Сообщение

Данное сообщение тематическое

Сообщение содержит картинки или видео 18+

Автор:

ВНИМАНИЕ! На данном подфоруме действуют строгие правила. Удостоверьтесь, что ваше сообщение соответствует им!

Форум или тема закрыты для гостей. Необходима авторизация!

Загрузить последнюю сохраненную версию

Вложение:

Вставить как галерею

Максимальный размер вложений: 4,0 МБ, аудио/видео: 8,0 МБ. Картинки большего размера ужимаются, если возможно.

Введите код, изображенный на картинке. Если код нечитаемый, кликните картинку, чтобы загрузить другой вариант.

Отправляя сообщение, я выражаю свое согласие с правилами форума и принимаю пользовательское соглашение.

Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр

Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Цикл по листам: усложненный вариант

6 сообщений из 6, страница 1 из 1

Цикл по листам: усложненный вариант

#34992826

Vk009

Гость

Здавствуйте!
Прошу помощи в решении следующей задачи:
Есть n-количество листов, первый лист называется условно "Лист1". Он выполняет роль списка. На каждом листе выполняется один и тот же "макрос1" по копированию диапазона с этого листа на "Лист1".
Проблема: запись макроса, создающего цикл со второго и до последнего листа с выполнением на каждом листе "макроса1". Сложность для меня в том, что "макрос1" активирует "Лист1", когда вставляет в него дипазон.
Просмотрел все страницы, выданные Yandexом, форум. Встречаются только циклы с перебором всех листов. Очень не хочется делать на абсолютных ссылках, тем более что число листов заранее неизвестно. Спасибо всем, кто сможет помочь.

...

Рейтинг:

0 / 0

06.12.2007, 22:43

| Ответить | Цитировать | Написать

Цикл по листам: усложненный вариант

#34992890

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

Гость

Спасибо за отклмк! У меня в таком случае зацикливается на одном и том же листе.
Нашел вот так макрос (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_###

Гость

Попробуйте 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_###

Гость

Код: plaintext

ActiveCell.Offset( 0 ,  0 ).Select

это круто

...

Рейтинг:

0 / 0

07.12.2007, 02:18

| Ответить | Цитировать | Написать

Цикл по листам: усложненный вариант

#34992965

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):

start [/forum/topic.php?fid=60&fpage=208&tid=2162981]:	0ms
get settings:	5ms
get forum list:	15ms
check forum access:	3ms
check topic access:	3ms
track hit:	61ms
get topic data:	9ms
get forum data:	2ms
get page messages:	38ms
get tp. blocked users:	2ms
others:	207ms

total:	345ms

	Необходимые cookie
	Cookie для сбора статистики
	Cookie для маркетинга и рекламы