excel - 根据先前列中的下拉列表使列成为强制性列

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