这是我第一次尝试使用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
答案 0 :(得分:2)
您需要遍历所有使用的行,并自行检查每个单元格。
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
答案 1 :(得分:0)
这应该做您想要的
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