VBA Excel. Цикл For… Next

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

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

Содержание

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

For counter = start To end [ Step step ]

[ statements ]

[ Exit For ]

[ statements ]

Next [ counter ]

For счетчик = начало To конец [ Step шаг ]

[ операторы ]

[ Exit For ]

[ операторы ]

Next [ счетчик ]

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

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

Компонент	Описание
counter	Обязательный атрибут. Числовая переменная, выполняющая роль счетчика, которую еще называют управляющей переменной цикла.
start	Обязательный атрибут. Числовое выражение, задающее начальное значение счетчика.
end	Обязательный атрибут. Числовое выражение, задающее конечное значение счетчика.
Step*	Необязательный атрибут. Оператор, указывающий, что будет задан шаг цикла.
step	Необязательный атрибут. Числовое выражение, задающее шаг цикла. Может быть как положительным, так и отрицательным.
statements	Необязательный** атрибут. Операторы вашего кода.
Exit For	Необязательный атрибут. Оператор выхода из цикла до его окончания.
Next [ counter ]	Здесь counter — необязательный атрибут. Это то же самое имя управляющей переменной цикла, которое можно здесь не указывать.

*Если атрибут Step отсутствует, цикл For… Next выполняется с шагом по умолчанию, равному 1.

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

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

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

Простейший цикл

Заполняем десять первых ячеек первого столбца активного листа Excel цифрами от 1 до 10:

Sub test1()

Dim i As Long

For i = 1 To 10

Cells(i, 1) = i

End Sub

Простейший цикл с шагом

В предыдущий цикл добавлен оператор Step со значением 3, а результаты записываем во второй столбец:

Sub test2()

Dim i As Long

For i = 1 To 10 Step 3

Cells(i, 2) = i

End Sub

Цикл с отрицательными аргументами

Этот цикл заполняет десять первых ячеек третьего столбца в обратной последовательности:

Sub test3()

Dim i As Long

For i = 0 To -9 Step -1

Cells(i + 10, 3) = i + 10

End Sub

Увеличиваем размер шага до -3 и записываем результаты в четвертый столбец активного листа Excel:

Sub test4()

Dim i As Long

For i = 0 To -9 Step -3

Cells(i + 10, 4) = i + 10

End Sub

Вложенный цикл

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

Sub test5()

Dim i1 As Long, i2 As Long

For i1 = 1 To 10

'Пятой ячейке в строке i1 присваиваем 0

Cells(i1, 5) = 0

For i2 = 1 To 4

Cells(i1, 5) = Cells(i1, 5) + Cells(i1, i2)

End Sub

Выход из цикла

В шестой столбец активного листа запишем названия десяти животных, конечно же, с помощью цикла For… Next:

Sub test6()

Dim i As Long

For i = 1 To 10

Cells(i, 6) = Choose(i, "Медведь", "Слон", "Жираф", "Антилопа", _

"Крокодил", "Зебра", "Тигр", "Ящерица", "Лев", "Бегемот")

End Sub

Следующий цикл будет искать в шестом столбце крокодила, который съел галоши. В ячейку седьмого столбца цикл, пока не встретит крокодила, будет записывать строку «Здесь был цикл», а когда обнаружит крокодила, запишет «Он съел галоши» и прекратит работу, выполнив команду Exit For. Это будет видно по ячейкам рядом с названиями животных ниже крокодила, в которых не будет текста «Здесь был цикл».

Sub test7()

Dim i As Long

For i = 1 To 10

If Cells(i, 6) = "Крокодил" Then

Cells(i, 7) = "Он съел галоши"

Exit For

Else

Cells(i, 7) = "Здесь был цикл"

End If

End Sub

Результат работы циклов For… Next из примеров:

Такие данные на активном листе Excel вы получите, если последовательно запустите на выполнение в редакторе VBA все семь подпрограмм из примеров, демонстрирующих работу циклов For… Next.

Цикл с дробными аргументами

Атрибуты start, end и step могут быть представлены числом, переменной или числовым выражением:

For i = 1 To 20 Step 2

For i = a To b Step c

For i = a - 3 To 2b + 1 Step c/2

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

'Значения атрибутов до округления

For i = 1.5 To 10.5 Step 2.51

'Округленные значения атрибутов

For i = 2 To 10 Step 3

Старайтесь не допускать попадания в тело цикла For… Next неокругленных значений аргументов, чтобы не получить непредсказуемые результаты его выполнения. Если без дробных чисел не обойтись, а необходимо использовать обычное округление, применяйте в коде VBA функцию рабочего листа WorksheetFunction.Round для округления числа перед использованием его в цикле For… Next.

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

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

Олег 28.05.2020 в 16:13

Добрый день. У меня есть столбик, с динамически заполненным количеством строк, между которыми два пробела.
Например:
1
1

22
22
22

32

33
34
И динамика строк разная может быть 1 значение, может быть 100.
Мне нужно в конце под каждый таким массивом в ячейке была их сумма.
Т.е. под первым сумма 2, дальше 66, дальше 32 дальше 67.
Я не могу задать сам цикл.
Спасибо!

Евгений 28.05.2020 в 21:54

Привет, Олег!
При условии, что между строками с числами всегда две пустые строки, и последняя ячейка столбца не заполнена, решение для первого столбца может быть таким:

Sub Primer()

Dim summa As Double, i As Long, stroka As Long

'Ищем последнюю заполненную строку + 1 для суммы

stroka = Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row + 1

For i = 1 To stroka

If Cells(i, 1) <> "" Then

summa = summa + Cells(i, 1)

Else

Cells(i, 1) = summa

summa = 0

'увеличиваем счетчик на единицу,

'чтобы пропустить вторую пустую строку

i = i + 1

End If

End Sub

Александр 29.05.2020 в 16:20

Добрый день!!!
Как сделать цикл просчета по строкам так что бы если в одном столбце строки объединены а в другом нет то что бы он передал таблицу в Word с названием объединенной строки и в шаблоне появились бы данные с другого столбца но по объединенной первой строке например:
первый столбец второй столбец
1 2
3
4
первый объединен отдельные строки
Den 20.11.2020 в 23:54

Никак не соображу, подскажите пожалуйста Евгений
Хочу диапазон дат вывести

1
2
3
4

Dim p As Variant
   For p = DTPicker1.Value To DTPicker2.Value
      Cells(p, 2) = p
   Next
1. Евгений 21.11.2020 в 00:38
  
  Привет, Den!
  Ваш код надо немного подправить:
  
  1
  2
  3
  4
  
  Dim p
      For p = 0 To DTPicker2.Value - DTPicker1.Value
          Cells(p + 1, 2) = DTPicker1.Value + p
      Next
Den 21.11.2020 в 13:30

Евгений, спасибо Вам большое!

OldBell 13.12.2020 в 17:00

Обычный цикл, сравниваются столбцы листов и если не совпало, заливает красным ячейку на одном листе.
Так закрашивает через одну, если не совпадение, то есть шаг цикла 2.
Приходится менять For z1 = 1 на For z1 = 2 что бы проверить все строки.

Sub check()

Dim z1 As Integer

For z1 = 1 To 100

Rem сравниваем столбец M на двух листах

If Sheets(1).Range("M" + CStr(z1)).Value Sheets(2).Range("M" + CStr(z1)).Value Then

Rem если значения разные, ячейка подкрашивается

Sheets(2).Range("M" + CStr(z1)).Interior.Color = vbRed

Else

Rem если значения одинаковые, заливка убирается

Sheets(2).Range("M" + CStr(z1)).Interior.Color = xlNone

End If

Rem сравниваем столбец L на двух листах

If Sheets(1).Range("L" + CStr(z1)).Value Sheets(2).Range("L" + CStr(z1)).Value Then

Sheets(2).Range("L" + CStr(z1)).Interior.Color = vbRed

Else

Sheets(2).Range("L" + CStr(z1)).Interior.Color = xlNone

End If

Rem и так далее

z1 = z1 + 1

Next z1

End Sub

1. Евгений 13.12.2020 в 17:20
  
  Уберите из цикла z1 = z1 + 1
2. 1. OldBell 13.12.2020 в 17:36
    
    а что уже не пишем?
    Вот спасибо не знал или уже забыл. Скорее всего переклинило. Сижу мучаюсь.
    А где я мог недавно счетчики наращивать?
Сергей 04.01.2021 в 11:46

Добрый день. А как сделать, чтобы Атрибуты start, end и step были представлены как время (00:00;00:01;00:02…..)?
1. Евгений 04.01.2021 в 22:23
  
  Здравствуйте, Сергей!
  Счетчик может принимать только числовые значения. Время можно преобразовать в число, например: Minute("00:05") или Second("00:00:15").
Сергей 05.01.2021 в 16:46

Спасибо Евгений.

Сергей 09.01.2021 в 13:28

Добрый день. Помогите разобраться с кодом. Пытаюсь запустить цикл с проверкой условия после выполнения(разветвление). Не понимаю почему не дант работать. Выделяется красным строка с условием If( If Range(«AM» & i2) < n2 GoTo Next i MsgBox "n2" ). Что я там неверно прописываю. Если значение в вычисляемой ячейке больше 25, вывести его в контрольном окне, после просмотра продолжить цикл. Если нет-продолжить цикл.

Sub ЦиклПроверкаВычисляемогоЗначения()

' ЦиклПроверкаВычисляемогоЗначения Макрос ' Перебираем капируя ячейки с временем

Dim n&, i&, Lr&, i2&, i3&, i4&, i5&, n2&

Lr = 12

i2 = 2

i3 = 3

i4 = 4

i5 = 5

n2 = 15

For n = 16 To 25 ' Диапазон клеток c 00:05 до 17:00 с шагом 00:01 минута

Worksheets("Лист1").Range("Z" & n).Copy _

Destination:=Worksheets("Лист1").Range("AH" & Lr)

For i = 16 To 27

Worksheets("Лист1").Range("Z" & i).Copy _

Destination:=Worksheets("Лист1").Range("AK" & Lr) ' Цикл копирования диапазона времени в контрольную ячейку

If Range("AM" & i2) < n2 GoTo Next i MsgBox "n2" 'Проверка контрольной ячейки

Next i

Next n

End Sub

1. Евгений 09.01.2021 в 13:38
  
  Привет, Сергей!
  Замените строку
  
  1
  
  If Range("AM" & i2) < n2 GoTo Next i MsgBox "n2"
  
  на
  
  1
  
  If Range("AM" & i2) < n2 Then MsgBox n2
  
  А если нужно: «Если значение в вычисляемой ячейке больше 25, вывести его в контрольном окне», тогда
  
  1
  
  If Range("AM" & i2) > 25 Then MsgBox Range("AM" & i2)

Other 09.02.2021 в 10:49

Добрый день. Необходимо поочередно открывать несколько книг, забирать одни и те же ячейки и вставлять в книгу со сдвигом столбцов на 3.
Скрипт написал, подскажите где не верно? вставляет значения с последнего файла.

Sub Close_Book()

Dim iFileNameSource As String

Dim vData, s

Dim rng As Range

Application.ScreenUpdating = False

vDate = Range("F3")

For i = 0 To 30

a = DateAdd("d", i, vDate)

Workbooks.Open (SourceFolder & "\" & ConvertMonth(Month(a)) & "\" & "Report-" & Format(a, "yyyymmdd") & ".xlsx")

iFileNameSource = "Report-" & Format(a, "yyyymmdd") & ".xlsx"

For s = 0 To 90 Step 3

ThisWorkbook.ActiveSheet.Cells(7, 6 + s).Value = Workbooks(iFileNameSource).Sheets("list1").Cells(44, 15).Value

ThisWorkbook.ActiveSheet.Cells(9, 6 + s).Value = Workbooks(iFileNameSource).Sheets("list1").Range("Q44").Value

ThisWorkbook.ActiveSheet.Cells(13, 6 + s).Value = Workbooks(iFileNameSource).Sheets("list1").Range("I6").Value

ThisWorkbook.ActiveSheet.Cells(17, 6 + s).Value = Workbooks(iFileNameSource).Sheets("list1").Range("O81").Value

ThisWorkbook.ActiveSheet.Cells(19, 6 + s).Value = Workbooks(iFileNameSource).Sheets("list1").Range("Q81").Value

ThisWorkbook.ActiveSheet.Cells(23, 6 + s).Value = Workbooks(iFileNameSource).Sheets("list1").Range("O100").Value

ThisWorkbook.ActiveSheet.Cells(25, 6 + s).Value = Workbooks(iFileNameSource).Sheets("list1").Range("Q100").Value

ThisWorkbook.ActiveSheet.Cells(29, 6 + s).Value = Workbooks(iFileNameSource).Sheets("list1").Range("O118").Value

ThisWorkbook.ActiveSheet.Cells(31, 6 + s).Value = Workbooks(iFileNameSource).Sheets("list1").Range("Q118").Value

ThisWorkbook.ActiveSheet.Cells(35, 6 + s).Value = Workbooks(iFileNameSource).Sheets("list1").Range("I137").Value

ThisWorkbook.ActiveSheet.Cells(39, 6 + s).Value = Workbooks(iFileNameSource).Sheets("list1").Range("O155").Value

ThisWorkbook.ActiveSheet.Cells(41, 6 + s).Value = Workbooks(iFileNameSource).Sheets("list1").Range("Q155").Value

ThisWorkbook.ActiveSheet.Cells(45, 6 + s).Value = Workbooks(iFileNameSource).Sheets("list1").Range("H174").Value

Application.DisplayAlerts = False

Workbooks(iFileNameSource).Close

Next i

Application.ScreenUpdating = True

End Sub

Евгений 09.02.2021 в 13:53

Добрый день! У вас значения вставляются из всех файлов в одни и те же ячейки, поэтому в результате они и содержат значения из последнего файла. Для сдвига диапазона используйте в цикле For s = 0 To 90 Step 3 ... Next s переменную i.

Other 10.02.2021 в 08:53

Евгений,добрый день. Написал так, все работает, но выглядит естественно не айс. Как это записать в цикле никак не могу додумать, мало опыта((в этом деле. Если подскажите буду благодарен.

If i = 0 Then

s = 0

ElseIf i = 1 Then

s = 3

ElseIf i = 2 Then

s = 6

ElseIf i = 3 Then

s = 9

ElseIf i = 4 Then

s = 12

ElseIf i = 5 Then

s = 15

ElseIf i = 6 Then

s = 18

1. Евгений 10.02.2021 в 09:02
  
  s = 3*i
2. 1. Other 10.02.2021 в 09:31
    
    Мдаа, довольно просто вышло, особенно когда кто-то подскажет). Спасибо вам!

Евгений 10.02.2021 в 09:15

Application.DisplayAlerts правильней будет так записать:

Dim rng As Range

Application.ScreenUpdating = False

Application.DisplayAlerts = False

----------------------------------

Application.ScreenUpdating = True

Application.DisplayAlerts = True

End Sub

Люба 01.03.2021 в 15:01

Евгений, большое спасибо за ваши уроки! Очень наглядно и доходчиво объясняете.
У меня вопрос, можно ли этап цикла задействовать в нескольких формулах одновременно?
Типа вот такого

Dim n, num_soch As Integer

n = DMax("Num_Ex", " Таблица1") 'определение количества экзаменов

'Дальше в идеале должен работать цикл

Dim i As Long

For i = 1 To n

num_soch = CurrentProject.Connection.Execute("SELECT Count(*) AS Количество FROM Таблица1 " _

& " WHERE Таблица1.Num_Ex=i").Fields(0) 'набор предметов для сравнения, № этапа цикла

MsgBox num_soch

Если я подставляю число в вычисление переменной num_soch, то всё считается, а вот если пытаюсь подставить i — То нет. Подскажите пожалуйста, так нельзя? Или я просто что-то неправильно записываю?

1. Евгений 01.03.2021 в 15:38
  
  Здравствуйте, Люба!
  Попробуйте заменить участок кода
  
  1
  
  " WHERE Таблица1.Num_Ex=i"
  
  на
  
  1
  
  " WHERE Таблица1.Num_Ex=" & i
2. 1. Люба 03.03.2021 в 10:43
    
    Помогло. Спасибо большое!
Владимир 05.04.2021 в 15:02

Добрый день!
Я много работаю графиков веду в Excel, и хотел бы с нуля освоить макросы! Скажите пожалуйста как и с чего начать?
1. Евгений 05.04.2021 в 15:44
  
  Здравствуйте, Владимир!
  Скачайте любой самоучитель по VBA Excel (они есть в открытом доступе). У меня тоже есть несколько статей для начинающих в первом разделе содержания рубрики. Возможно, они вам помогут начать программировать. Сам я изучал VBA, как и вы планируете, в процессе работы: приходило понимание, что какое-то действие пора автоматизировать, – начинал искать решение в интернете.
Ярослав 11.04.2021 в 19:48

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

Евгений 11.04.2021 в 20:13

Здравствуйте, Ярослав!
Следующий код, при нажатии кнопки, запишет пять слов в первые пять ячеек первого столбца:

Private Sub CommandButton1_Click()

Dim i As Long, myArr As Variant

myArr = Array("один", "два", "три", "четыре", "пять")

For i = 1 To 5

Cells(i, 1) = myArr(i - 1)

End Sub

Ярослав 11.04.2021 в 20:26

Возможно вы меня не так поняли, я пишу калькулятор, и мне нужно сохранять каждое записанное значение в ячейки(столбик), т.е. я ввожу значения в Textbox, жму кнопку, Значение уходит в столбик, Textbox чистится, и так пока я не нажму "=", такое возможно сделать?

Евгений 12.04.2021 в 22:33

Этот код будет записывать числа в первый столбец, переменная n объявляется в разделе Declarations модуля формы:

Dim n As Long

Private Sub UserForm_Initialize()

TextBox1.SetFocus

End Sub

Private Sub CommandButton1_Click()

n = n + 1

Cells(n, 1) = TextBox1.Text

TextBox1.Text = ""

TextBox1.SetFocus

End Sub

Private Sub CommandButton2_Click()

'ваш код для кнопки "="

n = 0

End Sub

Антон 03.06.2021 в 00:03

Добрый вечер.
Есть такой цикл:

For i = 1 To r

Worksheets("Junk").Cells(i, 1) = WorksheetFunction.RoundUp(((WorksheetFunction.Norm_Inv(Rnd, sr, ((mx - m) / 3.29))) / 100 * asf), -1)

Worksheets("Junk").Cells(i, 2) = WorksheetFunction.RoundUp(((WorksheetFunction.Norm_Inv(Rnd, sr, ((mx - m) / 3.29))) / 100 * asf), -1)

Worksheets("Junk").Cells(i, 3) = WorksheetFunction.RoundUp(((WorksheetFunction.Norm_Inv(Rnd, sr, ((mx - m) / 3.29))) / 100 * asf), -1)

Worksheets("Junk").Cells(i, 4) = WorksheetFunction.RoundUp(((WorksheetFunction.Norm_Inv(Rnd, sr, ((mx - m) / 3.29))) / 100 * asf), -1)

Worksheets("Junk").Cells(i, 5) = WorksheetFunction.RoundUp(((WorksheetFunction.Norm_Inv(Rnd, sr, ((mx - m) / 3.29))) / 100 * asf), -1)

Worksheets("Junk").Cells(i, 6) = WorksheetFunction.RoundUp(((WorksheetFunction.Norm_Inv(Rnd, sr, ((mx - m) / 3.29))) / 100 * asf), -1)

Next i

Значения sr, mx и m, asf и r — переменные и лежат на другом листе.
Значения asf и r — фактически постоянные (меняются пользователем по необходимости).
Цикл работает без проблем, но не могу понять как пройтись по диапазону в котором лежат значения sr, mx и m?
Заранее спасибо.

Евгений 03.06.2021 в 12:23

Добрый день, Антон!
Вариант учета интервала еще одной переменной (sr):

For i = 1 To r

For i2 = 1 To sr

Worksheets("Junk").Cells(i, i2) = WorksheetFunction.RoundUp(((WorksheetFunction.Norm_Inv(Rnd, i2, ((mx - m) / 3.29))) / 100 * asf), -1)

Worksheets("Junk").Cells(i, i2 + 1) = WorksheetFunction.RoundUp(((WorksheetFunction.Norm_Inv(Rnd, i2, ((mx - m) / 3.29))) / 100 * asf), -1)

Worksheets("Junk").Cells(i, i2 + 2) = WorksheetFunction.RoundUp(((WorksheetFunction.Norm_Inv(Rnd, i2, ((mx - m) / 3.29))) / 100 * asf), -1)

Worksheets("Junk").Cells(i, i2 + 3) = WorksheetFunction.RoundUp(((WorksheetFunction.Norm_Inv(Rnd, i2, ((mx - m) / 3.29))) / 100 * asf), -1)

Worksheets("Junk").Cells(i, i2 + 4) = WorksheetFunction.RoundUp(((WorksheetFunction.Norm_Inv(Rnd, i2, ((mx - m) / 3.29))) / 100 * asf), -1)

Worksheets("Junk").Cells(i, i2 + 5) = WorksheetFunction.RoundUp(((WorksheetFunction.Norm_Inv(Rnd, i2, ((mx - m) / 3.29))) / 100 * asf), -1)

Next i2

Next i

1. Антон 03.06.2021 в 14:48
  
  Спасибо!

Илья 08.06.2021 в 19:03

Доброго времени суток! Помогите! Не могу понять…. Вернее как бы могу но не совсем. Есть задача из списка пусть 50 наименований(один столбец) нужно их копировать в другой столбец, НО… в каждую шестую ячейку.
Вот так делаю

1
2
3
4

Dim i As Integer
For i = 6 To 16385 Step 6
Worksheets(1).Range("F" & i).Value = "=RC[3]"
Next

копирует каждое шестое наименование…
1. Евгений 08.06.2021 в 22:37
  
  Здравствуйте, Илья!
  Пример копирования ячеек столбца «A» в каждую шестую ячейку столбца «F»:
  
  1
  2
  3
  4
  
  Dim i As Long
  For i = 1 To 50
  Range("F" & i * 6) = Range("A" & i)
  Next
2. 1. Илья 09.06.2021 в 19:11
    
    Огромное спасибо!!!

Светлана 21.06.2021 в 22:37

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

for row = 7 to 56

if cells(row, 1) > 1000 then

percent = "огромные"

else if cells(row, 1) > 100 then

percent = "большие"

else if cells(row, 1) > 50 then

percent = "большие"

else if cells(row, 1) < 50 then

percent = "большие"

end if

end sub

Женя 29.07.2021 в 10:04

Здравствуйте. Подскажите, пожалуйста, код. В ячейки A1 и В1 вводится произвольный диапазон дат, а макрос должен ниже в этих столбцах выводить даты с интервалом в месяц.

Например, вводим А1 = 14.08.2021, В1= 03.12.2021. Получаем:

14.08.2021 14.09.2021
14.09.2021 14.10.2021
14.10.2021 14.11.2021
14.11.2021 03.12.2021
Илья 05.09.2021 в 12:48

Добрый день.
Подскажите как выполнить задание:
Используя цикл For в VBA повторите фигуру справа в красной рамке.
v v
v v
v v
v

Евгений 05.09.2021 в 13:23

Добрый день, Илья!
Это задание можно выполнить так:

Sub Primer()

Dim i1 As Long, i2 As Long

For i1 = 1 To 4

For i2 = 1 To 2

Cells(i1, i2 + 2) = Cells(i1, i2)

With Range("C1:D4")

.Borders(xlEdgeLeft).Color = xlContinuous

.Borders(xlEdgeLeft).Color = vbRed

.Borders(xlEdgeTop).Color = xlContinuous

.Borders(xlEdgeTop).Color = vbRed

.Borders(xlEdgeBottom).Color = xlContinuous

.Borders(xlEdgeBottom).Color = vbRed

.Borders(xlEdgeRight).Color = xlContinuous

.Borders(xlEdgeRight).Color = vbRed

End With

End Sub

1. Илья 05.09.2021 в 13:37
  
  Спаибо БОЛЬШОЕ, но нужно повторить расположение (рисунок) символа «V» в соседнем квадрате.
  v_______v
  _v_____v
  __v___v
  ___v_v
  ____v
  Только вместо «_» пустые клетки.

Илья 05.09.2021 в 15:38

Добрый день.
Сделал задание, но кажется можно упростить или нет?

Sub test1()

Dim i As Long

For i = 3 To 3

Cells(i, 2) = "V"

For i = 4 To 4

Cells(i, 3) = "V"

For i = 5 To 5

Cells(i, 4) = "V"

For i = 6 To 6

Cells(i, 5) = "V"

For i = 7 To 7

Cells(i, 6) = "V"

For i = 8 To 8

Cells(i, 7) = "V"

For i = 9 To 9

Cells(i, 8) = "V"

For i = 10 To 10

Cells(i, 9) = "V"

For i = 3 To 3

Cells(i, 16) = "V"

For i = 4 To 4

Cells(i, 15) = "V"

For i = 5 To 5

Cells(i, 14) = "V"

For i = 6 To 6

Cells(i, 13) = "V"

For i = 7 To 7

Cells(i, 12) = "V"

For i = 8 To 8

Cells(i, 11) = "V"

For i = 9 To 9

Cells(i, 10) = "V"

End Sub

Евгений 05.09.2021 в 18:30

Sub test2()

Dim i1 As Long, i2 As Long

For i1 = 1 To 9

If i1 < 6 Then

i2 = i2 + 1

Else

i2 = i2 - 1

End If

Cells(i2, i1) = "V"

End Sub

1. Илья 05.09.2021 в 19:40
  
  Добрый вечер.
  Спасибо за помощь!!!

Александр 25.09.2021 в 14:32

Добрый день! На кнопке стоит код(заполнение графика»день, ночь, 4, 8), при каждом нажатии заполняет(согласно условий) 4 ячейки. Не получается сделать цикл, чтобы при одном нажатии заполнялась вся строка графика в пределах диапазона Range(«B23:AF27») и доходя до диапазона Range(«AG23:AG29») цикл заканчивался.

Private Sub CommandButton11_Click()

Dim tdDay As Long, tdNoch As Long, tdcNoch As Long

Dim strOutput As String

Dim rngChasy As Range

tdDay = 11

tdNoch = 4

tdcNoch = 8

strOutput = ""

Set rngChasy = Range("AG23:AG29")

If Not Intersect(ActiveCell, Range("B23:AF27")) Is Nothing Then

If Intersect(ActiveCell, Range("B23:AF27")) = tdDay Then