Excel VBA Макросы: Удаление строки и вставка даты при открытии файла на основе двух столбцов.

Автор Aqua[LANG], 24 июля 2019, 13:11

Aqua[LANG]

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

В модуле этого листа находится такой код (сообщаю, чтобы не было конфликтов между двумя макросами):

Макрос

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Worksheets("Рабочие места").Protect Password:="123", UserInterfaceOnly:=True
If Len(ActiveCell) Then
      ActiveCell.Locked = True
   Else
      ActiveCell.Locked = False
           
    End If
End Sub
[свернуть]

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

Макрос нужно вставить в модуль "ЭтаКнига".

Макрос
Private Sub Workbook_Open()
   
    Dim sh As Worksheet, lr1 As Long, lr2 As Long
   
   
    '1. Присваиваем имя листу, с которым надо работать.
    Set sh = Worksheets("Рабочие места")
   
    '2 Если есть защита, то делаем её такой, чтобы макрос мог вносить изменения на лист, а юзер нет.
    sh.Protect Password:="123", UserInterfaceOnly:=True
   
    '3. Поиск последних строк в столбце A и B.
        ' End не ищет в скрытых строках.
    lr1 = sh.Cells(sh.Rows.Count, "A").End(xlUp).Row
    lr2 = sh.Cells(sh.Rows.Count, "B").End(xlUp).Row
   
    '4. Отключение событий, чтобы не запускалось событие на листе.
    Application.EnableEvents = False
   
    '5. Если номера строк совпадают.
    If lr1 = lr2 Then
        sh.Cells(lr1 + 1, "A").Value = Date
    '6. Если номера строк не совпадают.
    Else
        sh.Rows(lr1).Delete
        sh.Cells(lr1, "A").Value = Date
    End If
   
    '7. Включение событий.
    Application.EnableEvents = True
   
End Sub
[свернуть]

Aqua[LANG]

Спасибо! Все отлично! Надо таки изучить VBA, хоть по минимуму. Спасибо!