Сделать столбец обязательным на основе выпадающих в предыдущих столбцах

Question

Я впервые пытаюсь написать код с помощью VBA.У меня есть раскрывающийся список в ячейке A2 и раскрывающийся список в ячейке B2.

Если заполнены A2 и B2 (NotBlank?), Тогда пользователь должен ввести текст в D2 (я хотел бы убедиться, что текст длиннее 10 символов, надеясь, что никто не нажимает пробел 10 раз) илиони не могут сохранить (BeforeSave?), иначе они могут сохранить.

Мне также нужно сделать цикл.То есть, если A3 и B3 не пусты, то D3 является обязательным и т. Д. Надеюсь, это понятно.Пожалуйста, дайте мне знать, если мне нужно объяснить больше.

Вот код.Это работает для этой одной клетки, но как мне сделать это повторить?Я могу изменить диапазон?

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    If IsEmpty(Range("A2,B2")) = False Then
        MsgBox "You must enter commentary to validate your ratings"
    End If
End Sub

Answer 1

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

Option Explicit

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

    Dim ws As Worksheet 'specify which sheet here
    Set ws = ThisWorkbook.Worksheets("Sheet1")

    Dim LastRow As Long 'find last used row in column A
    LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    Dim iRow As Long
    For iRow = 2 To LastRow 'loop throug all used rows
        If ws.Cells(iRow, "A").Value <> vbNullString And _
           ws.Cells(iRow, "B").Value <> vbNullString And _
           ws.Cells(iRow, "D").Value = vbNullString Then
            MsgBox "You must enter commentary to validate your ratings. This file will not be saved!", vbExclamation
            Cancel = True 'do not save
            ws.Cells(iRow, "D").Select 'select missing cell
            Exit For
        End If
    Next iRow

End Sub

Другая идея

Это автоматически выберет все отсутствующие ячейки и не будет иметь петель.

Option Explicit

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1")

    Dim LastRow As Long
    LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    Dim ConstantsInA As Range
    Set ConstantsInA = ws.Range("A2:A" & LastRow).SpecialCells(xlCellTypeConstants)

    Dim ConstantsInB As Range
    Set ConstantsInB = ws.Range("B2:B" & LastRow).SpecialCells(xlCellTypeConstants)

    Dim EmptyCellsInD As Range
    Set EmptyCellsInD = ws.Range("D2:D" & LastRow).SpecialCells(xlCellTypeBlanks)

    Dim MissingValues As Range
    Set MissingValues = Intersect(ConstantsInA.EntireRow, ConstantsInB.EntireRow, EmptyCellsInD)

    If Not MissingValues Is Nothing Then
        MissingValues.Select 'select missing cells
        MsgBox "You must enter commentary to validate your ratings. This file will not be saved!", vbExclamation
        Cancel = True 'do not save
    End If
End Sub

Answer 2

Это должно делать то, что вы хотите

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

Dim c As Range

LastRow = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row

For Each c In Sheets("Sheet1").Range("A2:A" & LastRow)

    If c.Value <> "" And c.Offset(0, 1).Value <> "" And c.Offset(0, 3).Value = "" Then

        MsgBox "You must enter commentary in column D" & c.Row & " to validate your ratings before saving"
        Cancel = True

    End If
Next

End Sub