Excel VBA Макросы: Заполнение пустой ячейки текущей датой при условии не равенства значения других.

Автор VitaliyPegushin, 24 октября 2020, 14:46

VitaliyPegushin

Помогите в написании макроса, который бы заполнил столбец I текущей датой при условиях:
1. ячейка в столбце H пустая;
2. ячейки в столбцах С и E заполнены текстом (любым);
3. ячейка в столбце F не равна пустому значению, значению "Не требуется", значению "Не определен".

Поиск должен происходить на листе 1 (Лист с таблицей), а  результат нужно записать на лист 2 (Лист для вставки даты).

На обоих листах таблицы начинаются с одинаковых строк.

[вложение удалено администратором]

Администратор

В F18 после фразы "Не требуется" есть пробел. Его можно увидеть в строке формул: щёлкните в строке формул в конце, вы увидите, что между фразой и курсором есть пробел.
Для макроса фраза без пробела и с пробелом - это разные фразы.

Макрос
Sub Макрос()
   
    Dim ЛистИст As Worksheet, ЛистРез As Worksheet
    Dim lr As Long, i As Long
   
   
    ' Отключение монитора, чтобы ускорить макрос.
        ' Можно ещё отключить формулы, если их много.
    Application.ScreenUpdating = False
   
    ' Присваиваем имена листам, с которыми надо работать.
        ' Далее макрос будет обращаться к листам по этим именам.
    Set ЛистИст = Worksheets("Лист с таблицей")
    Set ЛистРез = Worksheets("Лист для вставки даты")
   
    ' Поиск последней строки на листе-источнике.
        ' End не ищет в скрытых строках.
    lr = ЛистИст.Cells(ЛистИст.Rows.Count, "C").End(xlUp).Row
   
    ' Движение по строкам со строки 16 и до последней строки.
    For i = 16 To lr
       
        ' Если ячейка в столбце H не пустая, то переход на следующую строку.
        If ЛистИст.Cells(i, "H").Value <> "" Then
            GoTo СледСтрока
        End If
       
        ' Если есть пустые ячейки в столбцах C, E, то переход на следующую строку.
        If (ЛистИст.Cells(i, "C").Value = "") Or (ЛистИст.Cells(i, "E").Value = "") Then
            GoTo СледСтрока
        End If
       
        ' Если в ячейке столбца F есть эти фразы, то переход на следующую строку.
            ' Сравнение делается с учётом регистра (больших / маленьких букв).
        Select Case ЛистИст.Cells(i, "F").Value
            Case "", "Не определен", "Не требуется"
                GoTo СледСтрока
        End Select
       
        ' Запись в столбец I текущей даты.
        ЛистРез.Cells(i, "I").Value = Date
       
СледСтрока:
    Next i
   
    ' Сообщение.
    Application.ScreenUpdating = True
    MsgBox "Готово.", vbInformation

End Sub
[свернуть]