Question

这是我第一次尝试使用VBA进行编码。我在单元格A2中有一个下拉列表，在单元格B2中有一个下拉列表。

如果填充了A2和B2（NotBlank？），则用户必须在D2中输入文本（我想确保文本长于10个字符-希望没人按下空格键10次），否则他们可以t保存（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

根据前几列中的下拉列表将列设为必选

2 个答案:

另一个想法