Гость
Войти | Профиль | Очистить
Целевая тема:
Создать новую тему:
Автор:
Действия ...
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Цикл по листам: усложненный вариант / 6 сообщений из 6, страница 1 из 1
06.12.2007, 22:43
    #34992826
Vk009
Vk009
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Цикл по листам: усложненный вариант
Здавствуйте!
Прошу помощи в решении следующей задачи:
Есть n-количество листов, первый лист называется условно "Лист1". Он выполняет роль списка. На каждом листе выполняется один и тот же "макрос1" по копированию диапазона с этого листа на "Лист1".
Проблема: запись макроса, создающего цикл со второго и до последнего листа с выполнением на каждом листе "макроса1". Сложность для меня в том, что "макрос1" активирует "Лист1", когда вставляет в него дипазон.
Просмотрел все страницы, выданные Yandexом, форум. Встречаются только циклы с перебором всех листов. Очень не хочется делать на абсолютных ссылках, тем более что число листов заранее неизвестно. Спасибо всем, кто сможет помочь.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
06.12.2007, 23:53
    #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
| Ответить | Цитировать | Написать  
07.12.2007, 00:51
    #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, 02:15
    #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:18
    #34992961
lena_###
lena_###
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Цикл по листам: усложненный вариант
Код: plaintext
ActiveCell.Offset( 0 ,  0 ).Select
это круто
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
07.12.2007, 02:42
    #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
| Ответить | Цитировать | Написать  
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Цикл по листам: усложненный вариант / 6 сообщений из 6, страница 1 из 1
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение  
Полит. конфиден.  
созд. / загр.: 369ms
Закрыть
start [/forum/topic.php?fid=60&mobile=1&tid=2162981]:
 0ms
get settings:
 7ms
get forum list:
 20ms
check forum access:
 4ms
check topic access:
 4ms
track hit:
 58ms
get topic data:
 11ms
get forum data:
 3ms
get page messages:
 44ms
get tp. blocked users:
 2ms
others: 216ms
total:  369ms
x
x
Закрыть


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