VBA Excel. Цикл For Each… Next

Цикл For Each… Next в VBA Excel, его синтаксис и описание отдельных компонентов. Примеры использования цикла For Each… Next.

Цикл For Each… Next в VBA Excel предназначен для выполнения блока операторов по отношению к каждому элементу из группы элементов (диапазон, массив, коллекция). Этот замечательный цикл применяется, когда неизвестно количество элементов в группе и их индексация, в противном случае, более предпочтительным считается использование цикла For…Next.

Содержание

1. Синтаксис цикла For Each… Next

2. Компоненты цикла For Each… Next

3. Примеры циклов For Each… Next

3.1. Цикл для диапазона ячеек

3.2. Цикл для коллекции листов

3.3. Цикл для массива

3.4. Цикл для коллекции подкаталогов и выход из цикла

Синтаксис цикла For Each… Next

For Each element In group

[ statements ]

[ Exit For ]

[ statements ]

Next [ element ]

В квадратных скобках указаны необязательные атрибуты цикла For Each… Next.

Компоненты цикла For Each… Next

Компонент	Описание
element	Обязательный атрибут в операторе For Each, необязательный атрибут в операторе Next. Представляет из себя переменную, используемую для циклического прохода элементов группы (диапазон, массив, коллекция), которая предварительно должна быть объявлена с соответствующим типом данных*.
group	Обязательный атрибут. Группа элементов (диапазон, массив, коллекция), по каждому элементу которой последовательно проходит цикл For Each… Next.
statements	Необязательный** атрибут. Операторы вашего кода.
Exit For	Необязательный атрибут. Оператор выхода из цикла до его окончания.

*Если цикл For Each… Next используется в VBA Excel для прохождения элементов коллекции (объект Collection) или массива, тогда переменная element должна быть объявлена с типом данных Variant, иначе цикл работать не будет.

**Если не использовать в цикле свой код, смысл применения цикла теряется.

Примеры циклов For Each… Next

Цикл для диапазона ячеек

На активном листе рабочей книги Excel выделите диапазон ячеек и запустите на выполнение следующую процедуру:

Sub test1()

Dim element As Range, a As String

a = "Данные, полученные с помощью цикла For Each... Next:"

For Each element In Selection

a = a & vbNewLine & "Ячейка " & element.Address & _

" содержит значение: " & CStr(element.Value)

MsgBox a

End Sub

Информационное окно MsgBox выведет адреса выделенных ячеек и их содержимое, если оно есть. Если будет выбрано много ячеек, то полностью информация по всем ячейкам выведена не будет, так как максимальная длина параметра Prompt функции MsgBox составляет примерно 1024 знака.

Цикл для коллекции листов

Скопируйте следующую процедуру VBA в стандартный модуль книги Excel:

Sub test2()

Dim element As Worksheet, a As String

a = "Список листов, содержащихся в этой книге:"

For Each element In Worksheets

a = a & vbNewLine & element.Index _

& ") " & element.Name

MsgBox a

End Sub

Информационное окно MsgBox выведет список наименований всех листов рабочей книги Excel по порядковому номеру их ярлычков, соответствующих их индексам.

Цикл для массива

Присвоим массиву список наименований животных и в цикле For Each… Next запишем их в переменную a. Информационное окно MsgBox выведет список наименований животных из переменной a.

Sub test3()

Dim element As Variant, a As String, group As Variant

group = Array("бегемот", "слон", "кенгуру", "тигр", "мышь")

'или можно присвоить массиву значения диапазона ячеек

'рабочего листа, например, выбранного: group = Selection

a = "Массив содержит следующие значения:" & vbNewLine

For Each element In group

a = a & vbNewLine & element

MsgBox a

End Sub

Повторим ту же процедуру VBA, но всем элементам массива в цикле For Each… Next присвоим значение «Попугай». Информационное окно MsgBox выведет список наименований животных, состоящий только из попугаев, что доказывает возможность редактирования значений элементов массива в цикле For Each… Next.

Sub test4()

Dim element As Variant, a As String, group As Variant

group = Array("бегемот", "слон", "кенгуру", "тигр", "мышь")

'или можно присвоить массиву значения диапазона ячеек

'рабочего листа, например, выделенного: group = Selection

a = "Массив содержит следующие значения:" & vbNewLine

For Each element In group

element = "Попугай"

a = a & vbNewLine & element

MsgBox a

End Sub

Этот код, как и все остальные в этой статье, тестировался в Excel 2016.

Цикл для коллекции подкаталогов и выход из цикла

В этом примере мы будем добавлять в переменную a названия подкаталогов на диске C вашего компьютера. Когда цикл дойдет до папки Program Files, он добавит в переменную a ее название и сообщение: «Хватит, дальше читать не буду! С уважением, Ваш цикл For Each… Next.».

Sub test5()

Dim FSO As Object, myFolders As Object, myFolder As Object, a As String

'Создаем новый FileSystemObject и присваиваем его переменной "FSO"

Set FSO = CreateObject("Scripting.FileSystemObject")

'Извлекаем список подкаталогов на диске "C" и присваиваем

'его переменной "myFolders"

Set myFolders = FSO.GetFolder("C:\")

a = "Папки на диске C:" & vbNewLine

'Проходим циклом по списку подкаталогов и добавляем в переменную "a"

'их имена, дойдя до папки "Program Files", выходим из цикла

For Each myFolder In myFolders.SubFolders

a = a & vbNewLine & myFolder.Name

If myFolder.Name = "Program Files" Then

a = a & vbNewLine & vbNewLine & "Хватит, дальше читать не буду!" _

& vbNewLine & vbNewLine & "С уважением," & vbNewLine & _

"Ваш цикл For Each... Next."

Exit For

End If

Set FSO = Nothing

MsgBox a

End Sub

Информационное окно MsgBox выведет список наименований подкаталогов на диске C вашего компьютера до папки Program Files включительно и сообщение цикла о прекращении своей работы.

В результате работы программы будут выведены не только наименования подкаталогов, видимых при переходе в проводнике к диску C, но и скрытые и служебные папки. Для просмотра списка всех подкаталогов на диске C, закомментируйте участок кода от If до End If включительно и запустите выполнение процедуры в редакторе VBA Excel.

Содержание рубрики VBA Excel по тематическим разделам со ссылками на все статьи.

46 комментариев для “VBA Excel. Цикл For Each… Next”

Mid 14.05.2021 в 06:30

Здравствуйте!
Я новичок в VBA, поэтому ,возможно, вопрос глупый, но не могу никак придумать процедуру для сравнения двух массивов с помощью цикла For Each… Next.
т.е. имеются столбцы A:B — ФИО1 Дата1 и столбцы C:D — ФИО2 Дата2. Хочу сравнить и при совпадении выделить совпадающие ячейки цветом.
Подскажите, хотя бы примерно, как это сделать.
Спасибо

Евгений 14.05.2021 в 20:09

Здравствуйте!
Диапазоны в примере одинаковые по размеру, но могут быть любые:

Sub Primer()

Dim myCell1 As Range, myCell2 As Range

For Each myCell1 In Range("A1:B50")

Set myCell2 = Range("C1:D50").Find(myCell1)

If Not myCell2 Is Nothing Then

myCell1.Interior.Color = vbGreen

myCell2.Interior.Color = vbGreen

End If

End Sub

Mid 18.05.2021 в 09:51

Спасибо большое, Евгений!
Я немного неправильно сформулировал.
Нужно выделить, если пары ФИО и Дата совпадают.
т.е. Иванов 1979 и Иванов 1979 выделялись, а Иванов 1979 и Иванов 1980 нет. Так же как и Иванов 1979 и Петров 1979 не нужно выделять.
Пока придумал только если создать дополнительные столбцы и в них прописать «=A1&B1» и по ним сравнивать.
Можно ли как то сделать по другому?

Евгений 18.05.2021 в 15:11

Можно и по-другому, попробуйте так:

Sub Primer()

Dim i1 As Long, i2 As Long, myArr As Variant

myArr = Range("A1:D100")

For i1 = 1 To 100

For i2 = 1 To 100

If myArr(i1, 1) & myArr(i1, 2) = myArr(i2, 3) & myArr(i2, 4) Then

Cells(i1, 1).Interior.Color = vbGreen

Cells(i1, 2).Interior.Color = vbGreen

Cells(i2, 3).Interior.Color = vbGreen

Cells(i2, 4).Interior.Color = vbGreen

End If

End Sub

1. Mid 19.05.2021 в 04:56
  
  Спасибо огромное. То, что нужно!
2. Сергей Васильевич 10.03.2023 в 15:41
  
  Добрый день.
  Есть задача посложнее.
  Лист 1 . А1 инвентарный номер (10 или 12 знаков) . В1 колличество полученных деталей.
  Лист 2 . Колонка J содержит инвентарный номер (может быть несколько строк). Колонка S содержит текст внутри которого колличество полученных деталей (B1 листа 1). Колонка N содержит дату получения деталей.
  Задача надо найти по данным Листа1 совпадение А1&В1 на Листе 2 данные колонки n

Дарья 14.09.2021 в 17:00

Здравствуйте!
Подскажите пожалуйста, как с помощью цикла For Each…Next можно выполнить задачу:
Есть диапазон со значениями, например («B1:С5»)
Нужно все значения из этого диапазона последовательно вынести в столбец A (раздельно, не в одну ячейку)

Евгений 14.09.2021 в 18:21

Здравствуйте, Дарья!

Sub Primer()

Dim myCell As Range, n As Integer

For Each myCell In Range("B1:C5")

n = n + 1

Cells(n, 1) = myCell

End Sub

1. Дарья 15.09.2021 в 09:09
  
  Большое спасибо!
  У вас очень классный сайт, существенно мне помог разобраться в VBA Excel

Михаил 20.10.2021 в 16:49

Добрый день, очень часто пользуюсь информацией с Вашего сайта, но вот тут возникла задача, с которой справиться не получается, возможно вы сможете помочь.
У меня есть массив:

1
2

Dim mass1 As Variant
mass1 = Лист1.Range(Лист1.Cells(13, 4), Лист1.Cells(1236, 19))

В данном массиве необходимо сравнить каждую ячейку с каждой из этого же массива и найти такую же цифру, только с противоположным знаком, если такой цифры с противоположным знаком нет -> (то вывести в столбик такие цифры, к которым нет противоположных), а если есть цифра с противоположным знаком -> (то ничего делать с ней не нужно).

Евгений 21.10.2021 в 04:46

Здравствуйте, Михаил!

Sub Test()

Dim mass1 As Variant, val1 As Variant, val2 As Variant, n As Long

mass1 = Range(Лист1.Cells(13, 4), Лист1.Cells(1236, 19))

For Each val1 In mass1

For Each val2 In mass1

If val1 = val2 * (-1) Then Exit For

If val1 <> val2 * (-1) Then

n = n + 1

Лист1.Cells(n, 1) = val1

End If

End Sub

Найденные числа записываются в первый столбец листа «Лист1». Пустые ячейки (нули) игнорируются.

1. test 24.11.2022 в 12:59
  
  Правильно ли будет отрабатываться условие "если такой цифры с противоположным знаком нет -> (то вывести в столбик такие цифры, к которым нет противоположных)" во втором цикле? Будет ложное срабатывание, когда val1=5 и val2=6, например, ведь 5<>-6.
2. 1. Евгений 24.11.2022 в 16:27
    
    Привет!
    Условие
    
    1
    
    If val1 <> val2 * (-1) Then
    
    проверяет, с какими значениями переменных закончился внутренний цикл. Если это 5 и 6, значит в массиве нет значения -5, и это не ложное, а верное срабатывание.

Дарья 05.11.2021 в 01:29

Добрый вечер! Подскажите, пожалуйста, как исправить проблему? Дана строка символов, и нужно определить, встречаются ли в ней 5 символов «$» и 3 символа «%»? Почему-то в любом случае результат, что «Символы не встречаются». Заранее спасибо.

Private Sub CommandButton1_Click()

Dim s, s1, k As String, n1, n2, i As Integer

s1 = TextBox1.Text

n1 = 0

n2 = 0

For Each s In Split(TextBox1.Text)

If s Like "*$*" Then n1 = n1 + 1

If s Like "*%*" Then n2 = n2 + 1

If ((n1 >= 5) And (n2 >= 3)) Then

k = "Символы встречаются"

Else

k = "Символы не встречаются"

End If

Label2.Caption = k

End Sub

Евгений 05.11.2021 в 13:16

Дарья, объявление переменных

1	Dim s, s1, k As String

соответствует объявлению

1	Dim s As Variant, s1 As Variant, k As String

А код измените следующим образом:

Private Sub CommandButton1_Click()

Dim s As String, k As String

s = TextBox1.Text

If s Like "*$$$$$*" And s Like "*%%%*" Then

k = "Символы встречаются"

Else

k = "Символы не встречаются"

End If

Label2.Caption = k

End Sub

Елена 23.01.2022 в 15:22

Здравствуйте.
Подскажите, пожалуйста, как выполнить задачу. Есть лист1. В нем столбик А с ячейками ID(заранее известно количество строк). Нужно сравнить с ячейками ID столбика А листа2 и при совпадении записать данные из столбика К листа1 в столбик D листа2 вместе с цветом ячейки. В листе2 не известно заранее сколько строк. Я написала начало, дальше не пойму как.

Sub Macros1()

Dim shet1 As Range

Dim shet2 As Range

Set shet1 = Worksheets("22.11-28.11").Cells(3, 1)

Set shet2 = Cells(3, 1)

If shet2 = shet1 Then

Cells(3, 4) = Worksheets("22.11-28.11").Cells(3, 11)

ElseIf shet2 shet1 Then

Cells(3, 4) = "not"

End If

End Sub

Евгений 23.01.2022 в 17:43

Здравствуйте, Елена!
Как я понял из вашего кода, просмотр начинается с 3 строки. Вот два варианта решения, где вам нужно только заменить Лист11 на Worksheets("22.11-28.11") и Лист12 на второй ваш лист:

Sub Macros1()

Dim i1 As Long, i2 As Long, n1 As Long, n2 As Long

'Определяем количество строк на первом листе

n1 = Лист11.Range("A3").CurrentRegion.Rows.Count

'Определяем количество строк на втором листе

n2 = Лист12.Range("A3").CurrentRegion.Rows.Count

For i1 = 3 To n1

For i2 = 3 To n2

If Лист11.Range("A" & i1) = Лист12.Range("A" & i2) Then

Лист12.Range("D" & i2) = Лист11.Range("K" & i1)

'Выходим из внутреннего цикла, если совпадение уже найдено

Exit For

End If

End Sub

Sub Macros2()

Dim i As Long, n As Long

'Определяем количество строк на втором листе

n = Лист12.Range("A3").CurrentRegion.Rows.Count

For i = 3 To n

On Error Resume Next

Лист12.Range("D" & i) = WorksheetFunction.VLookup(Лист12.Range("A" & i), Лист11.Range("A3").CurrentRegion, 11, False)

End Sub

Елена 24.01.2022 в 19:13

Спасибо большое! Первый вариант мне как-то более понятен. Т.е. теперь, чтобы передать цвет ячейки, надо дописать перед выходом из внутреннего цикла

1

Лист12.Range("D" & i2).Interior.Color = Лист11.Range("K" & i1).Interior.Color

Только это не работает.

Евгений 24.01.2022 в 19:31

Елена, вы правильно написали, надо добавить именно эту строку, и она работает — только что проверил. Может быть, вы в ней не поменяли названия листов?

Елена 24.01.2022 в 19:46

Да работает. Просто цвета, созданные условным форматированием, не переносятся

Евгений 24.01.2022 в 20:20

Попробуйте

1 2	Лист12.Range("D" & i2) = Лист11.Range("K" & i1) Лист12.Range("D" & i2).Interior.Color = Лист11.Range("K" & i1).Interior.Color

заменить на

Лист11.Range("K" & i1).Copy

Лист12.Range("D" & i2).PasteSpecial xlPasteFormulas

Лист12.Range("D" & i2).PasteSpecial xlPasteFormats

Лист12.Range("D" & i2).PasteSpecial xlPasteValues

Результат не гарантирован, так как он будет зависеть от формулировок правил условного форматирования.

1. Елена 25.01.2022 в 21:26
  
  Как-то частично переносит цвет.
  Заметила, что и на первом листе и на втором игнорируется последняя строка. Поставила n1 + 1, n2 + 1 и все работает как надо.

Наталья 06.04.2022 в 23:53

Подскажите, пожалуйста,как обозначить выполнение цикла операций после проведения отбора каждого из возможных значений по одному из столбцов?
Есть массив данных(много столбцов) с разными значениями в ячейках столбца День(от 1до 31). Нужно последовательно для каждого дня вывести массив, скопировать его (отдельные части) и перенести в другую книгу. Так для каждого дня. Т.е последовательно скопировать и вставить массивы данных в другую книгу. В общем массиве могут быть не все даты месяца.

Денис 11.08.2022 в 16:34

Подскажите пожалуйста есть ли способ с помощью этого цикла перекрасить объекты (Shape) имеющие в себе гиперссылки (Hyperlink) во всей книге.
Для листа у меня вышло а для книги не могу понять как, прошу помощи так как только начал разбираться в vba.
Код макроса.

Public Sub TestMe()

If MsgBox("Вы уверены, что хотите запустить проверку текущего листа?", vbOKCancel) = vbCancel Then

Exit Sub

End If

On Error Resume Next

Dim sh As Shape

For Each sh In ActiveSheet.Shapes

On Error Resume Next

sh.Hyperlink.Shape.Fill.ForeColor.RGB = RGB(255, 21, 12)

On Error GoTo 0

Next sh

MsgBox ("Проверка завершена! & vbCrLf & vbCrLf & "Фигуры в которых есть гиперссылка окрашены красным.")

End Sub

Евгений 13.08.2022 в 00:23

Здравствуйте, Денис!
Ваш код для всей текущей книги:

Public Sub TestMe()

Dim mySheet As Worksheet

For Each mySheet In ThisWorkbook.Worksheets

If MsgBox("Вы уверены, что хотите запустить проверку листа " & mySheet.Name & "?", vbOKCancel) = vbCancel Then

Exit Sub

End If

On Error Resume Next

Dim sh As Shape

For Each sh In ActiveSheet.Shapes

On Error Resume Next

sh.Hyperlink.Shape.Fill.ForeColor.RGB = RGB(255, 21, 12)

On Error GoTo 0

Next sh

MsgBox ("Проверка завершена!" & vbCrLf & vbCrLf & "Фигуры в которых есть гиперссылка окрашены красным.")

Next mySheet

End Sub

Владимир 06.11.2022 в 18:01

Здравствуйте. А как быть, если выбраны пользователем несмежные ячейки? Перебор не идёт (
1. Евгений 07.11.2022 в 18:40
  
  Здравствуйте, Владимир!
  У меня цикл For Each… Next работает и с выбранными несмежными ячейками — Selection, и с заданными как объект Range — Range("B4:B5,D7:D8,G1:G2"). Проверьте у себя еще раз на примере цикла для диапазона ячеек (test1).
Андрей 19.12.2022 в 08:31

Здравствуйте.
Я инженер, работаю со сметами. У нас разделы в смете, и после каждого раздела нужна подсчитать итог, разделы начинаются : " РАЗДЕЛ "НОМЕР" ****** ". У меня не получается никак. Подскажите пожалуйста.
1. Евгений 19.12.2022 в 20:01
  
  Здравствуйте, Андрей!
  Недостаточно информации для понимания ситуации. Объясните структуру сметы: в каком столбце находятся названия разделов, какие диапазоны надо суммировать, куда записывается результат суммирования.
2. 1. Андрей 20.12.2022 в 10:39
    
    Таблица в столбцах A:H. Раздел находится в столбцах B:F (одна строка) мне нужно суммировать столбец H от первого раздела до следующего раздела ( все разделы по отдельности). Вверху раздела одна пустая строка, там должно вписаться результат суммы раздела в столбце H. Все разделы должны по отдельности суммироваться.
  2. 1. Евгений 21.12.2022 в 09:28
      
      По вашему описанию я представляю так:
      
      Сстрока 1 — шапка таблицы.
      
      Блок раздела 1:
      ячейка B2 — наименование раздела (РАЗДЕЛ 1)
      диапазон H3-H8 — диапазон суммирования
      ячейка H9 — сумма
      
      Блок раздела 2:
      ячейка B10 — наименование раздела (РАЗДЕЛ 2)
      диапазон H11-H20 — диапазон суммирования
      ячейка H21 — сумма
      
      и так далее (диапазон суммирования — величина переменная). Правильно?
Андрей 21.12.2022 в 13:39

Да. Но разделы не "B2" а "B2:F2" то есть они объединены в одну строку (столбцы). Разделы начинаются со слова , например "Раздел 1. Кровля", то есть разделы начинается : "Раздел "номер" "****". и т.д. Мне нужно пробегаться по этим разделам и вставить итог в конце. Остальное все правильно.

Евгений 21.12.2022 в 17:39

Андрей, в объединенной ячейке отображается только значение первой ячейки, поэтому обращаться к объединенной ячейке "B2:F2" будем "B2". Код будет работать при отсутствии пустых ячеек внутри суммируемых диапазонов, нули допускаются:

Sub Primer1()

Dim n As Long, m As Long, i As Long

n = Cells(ActiveSheet.Rows.Count, "B").End(xlUp).Row

For i = 1 To n

If Left(Cells(i, "B"), 6) = "Раздел" Then

m = Cells(i, "H").End(xlDown).Row

Cells(m + 1, "H") = WorksheetFunction.Sum(Range(Cells(i, "H"), Cells(m, "H")))

End If

End Sub

1. Андрей 22.12.2022 в 19:14
  
  Привет, Евгений. Ну я вписал, не работает, только n подсчитывает последнюю строку. Сумма в столбце H не вставляется, m тоже не работает.
2. 1. Евгений 22.12.2022 в 20:26
    
    Андрей, у меня все работает. Возможно, у вас структура таблицы другая.

Андрей 23.12.2022 в 22:22

В строке раздела в столбце «H» пусто.
Структура:
В 1 столбце нумерация.
В 2ом обоснование.
В 3ем наименование.
В 4ем ед.измерение.
В 5ом норма.
В 6ом по проекту.
В 7ом цена
В 8ом сумма.

Евгений 24.12.2022 в 12:10

Если на пересечении строки раздела и столбца «H» пусто, тогда:

Sub Primer2()

Dim n As Long, m As Long, i As Long

n = Cells(ActiveSheet.Rows.Count, "B").End(xlUp).Row

For i = 1 To n

If Left(Cells(i, "B"), 6) = "Раздел" Then

m = Cells(i + 1, "H").End(xlDown).Row

Cells(m + 1, "H") = WorksheetFunction.Sum(Range(Cells(i + 1, "H"), Cells(m, "H")))

End If

End Sub

Андрей 24.12.2022 в 21:55

Привет Евгений. Можно функцию сумм как формулу ввести, чтобы в ячейке была формула?

Евгений 25.12.2022 в 12:01

Можно и формулу вставить:

Sub Primer3()

Dim n As Long, m As Long, i As Long

n = Cells(ActiveSheet.Rows.Count, "B").End(xlUp).Row

For i = 1 To n

If Left(Cells(i, "B"), 6) = "Раздел" Then

m = Cells(i + 1, "H").End(xlDown).Row

Cells(m + 1, "H").FormulaLocal = "=СУММ(" & Cells(i + 1, "H").Address & ":" & Cells(m, "H").Address & ")"

End If

End Sub

1. Андрей 25.12.2022 в 13:01
  
  Спасибо Евгений, удачи тебе, очень помог!!..

Никита 13.02.2023 в 15:30

Здравствуйте, по работе нужно модернизировать существующий макрос, чтобы он для ячеек из диапазона столбцов от G до N заполнял пустые ячейки прочерками "-", как я полагаю, используя For Each, можете помочь?

Sub форматированиеПубликации() Dim ind_sheets As Integer 'индекс листа' Dim ind_row As Integer 'индекс строки' Application.ScreenUpdating = False 'форматирование листов с №4 по №17 ' For ind_sheets = 4 To 17 'Sheets.Count' Sheets(ind_sheets).Activate ind_row = 8 While ActiveSheet.Cells(ind_row, 2).Value & ActiveSheet.Cells(ind_row, 3).Value & ActiveSheet.Cells(ind_row, 4).Value & ActiveSheet.Cells(ind_row, 5).Value & ActiveSheet.Cells(ind_row, 6).Value & ActiveSheet.Cells(ind_row, 7).Value <> "" If (ActiveSheet.Cells(ind_row, 2).Value <> "") And (ActiveSheet.Cells(ind_row, 3).Value = "") And (ActiveSheet.Cells(ind_row, 4).Value <> "") Then ActiveSheet.Range("B" & CStr(ind_row) & ":B" & CStr(ind_row)).EntireRow.AutoFit Application.DisplayAlerts = False ActiveSheet.Range("B" & CStr(ind_row) & ":N" & CStr(ind_row)).Merge Application.DisplayAlerts = True ActiveSheet.Range("B" & CStr(ind_row) & ":N" & CStr(ind_row)).Borders(xlDiagonalDown).LineStyle = xlNone ActiveSheet.Range("B" & CStr(ind_row) & ":N" & CStr(ind_row)).Borders(xlDiagonalUp).LineStyle = xlNone 'настройка стилей' ' ActiveSheet.Range("B" & CStr(ind_row) & ":B" & CStr(ind_row)).EntireRow.AutoFit Else End If ActiveSheet.Range("B" & CStr(ind_row) & ":C" & CStr(ind_row)).EntireRow.AutoFit ind_row = ind_row + 1 Wend ' MsgBox "Форматирование " & ActiveSheet.Name & " выполнено" ind_row = ind_row + 1 While ActiveSheet.Cells(ind_row, 1).Value & ActiveSheet.Cells(ind_row, 3).Value & ActiveSheet.Cells(ind_row, 4).Value <> "" Application.DisplayAlerts = False ActiveSheet.Range("A" & CStr(ind_row) & ":N" & CStr(ind_row)).Merge ActiveSheet.Range("A" & CStr(ind_row) & ":N" & CStr(ind_row)).HorizontalAlignment = xlLeft Application.DisplayAlerts = True ind_row = ind_row + 1 Wend ActiveSheet.PageSetup.PrintArea = "$A$1:$N$" & CStr(ind_row - 1) Next ind_sheets
1. Евгений 18.02.2023 в 23:52
  
  Здравствуйте, Никита!
  Если еще актуально, попробуйте после первой строки с While… вставить следующий код:
  
  1
  2
  3
  4
  
  Dim myCell As Range
  For Each myCell In ActiveSheet.Range("G" & ind_row & ":N" & ind_row)
  If myCell = "" Then myCell = "-"
  Next myCell
Paralex75 15.02.2023 в 22:37

Добрый день,
Начал изучать VBA недавно и спотыкнулся на инструменте For Each…Next. Не могу понять как он работает
Например взял код на Microsoft Learn
Dim TestArray(10) As Integer, I As Variant For Each I In TestArray TestArray(I) = I Next I
В моем понимании, по результатам выполнения программы массив должен быть наполнен: 0,1,2,3,4…
Но в итоге там нули. Вставил Debug.Print I в цикле, вижу что циклы проходят в нужном количестве, но каждый раз I=0, соответственно и массив заполнен нулями. Особенно странно что код взят с сайта Microsoft в формате copy-paste и не работает как там написано.

Другая ситуация. Немного переделанный код с Вашего сайта:
Sub Primer1() Dim myRange, myArr(), el, ub, n, in1, in2 Set myRange = Range("B3:G7") myArr = myRange.Value 'присваиваем массиву значения указанного диапазона ub = UBound(myArr) 'определяем верхнюю границу первого измерения(индекса) массива Debug.Print UBound(myArr) Debug.Print UBound(myArr, 2) For Each el In myArr Debug.Print el If el = 17 Then ' ищем например индекс 17 in1 = (n Mod ub) + 1 ' вычисляем индекс первого измерения in2 = (n \ ub) + 1 ' вычисляем индекс второго измерения ' отображаем результаты в окне Immediate Debug.Print "Индекс первого измерения: " & in1 'Результат: 3 Debug.Print "Индекс второго измерения: " & in2 'Результат: 5 End If n = n + 1 Next End Sub
Вроде все работает. Но "Debug.Print el" показывает что цикл проходит по значениям в массиве в беспорядочном порядке. Это конструкция так и должна работать?

Paralex75 15.02.2023 в 22:52

Понял почему нули в первом коде от MS. Значение управляющей переменной цикла I в For Each хранит текущее значение ячейки массива который «сканируется». Поэтому нули и остаются. Непонятно почему MS приводит пример данного кода для объяснения работы цикла For Each, сам код получается бессмысленным.
Остается вопрос почему «сканирование» идет в беспорядочном порядке.

Евгений 16.02.2023 в 00:24

Здравствуйте!
Вместо первого примера используйте следующий код, где значениям массива присвоены их индексы:

Sub Primer()

Dim TestArray() As Variant, I As Variant

TestArray = Array(0, 1, 2, 3, 4, 5, 6, 7, 8, 9)

For Each I In TestArray

Debug.Print TestArray(I)

End Sub

Во втором случае обход элементов массива тоже идет по порядку: если смотреть на диапазон, откуда скопированы значения, то сверху вниз — слева направо, то есть по столбцам. Не забудьте, что вначале метод Debug.Print выводит на печать UBound(myArr) и UBound(myArr, 2).

Евгений 16.02.2023 в 00:38

Да, еще: когда цикл нашел то, что нужно было найти, его можно остановить с помощью оператора (строки кода) — Exit For. В статью Определение координат элемента массива, откуда вы взяли код, я добавил выход из цикла.

Обсуждение закрыто.