Question

我正在运行数据验证，如果某些列缺少数据，将停止保存。但是，它不起作用。我不知道为什么。以下是代码：如果有人可以看看，我将不胜感激。另外，如何对丢失的数据单元进行过滤和颜色编码以便于识别？谢谢!!!

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
ThisWorkbook.Worksheets("codes").Unprotect Password:="000"

Dim Rng As Range
Dim wb As Workbook
Dim MyWb As Worksheet
Dim i As Long
Dim lrow As Long
Const rowno = 8
Const colno = 1On Error GoTo exitHandler
Set Rng = Cells.SpecialCells(xlCellTypeAllValidation)
If Rng Is Nothing Then GoTo exitHandler
   If Not Intersect(Target, Rng) Is Nothing Then
      Else
      Application.EnableEvents = False

      Set wb = ActiveWorkbook
      Set MyWb = ThisWorkbook.Worksheets("codes")
      lrow = MyWb.Cells(Rows.Count, colno).End(xlUp).Row
      Start = Cells(rowno, colno)

      For i = 8 To lrow
         If IsEmpty(MyWb.Range("A" & i)) Or IsEmpty(MyWb.Range("B" & i)) Or IsEmpty(MyWb.Range("E" & i)) Or IsEmpty(MyWb.Range("F" & i)) Or IsEmpty(MyWb.Range("G" & i)) Or IsEmpty(MyWb.Range("H" & i)) Or IsEmpty(MyWb.Range("J" & i)) Or IsEmpty(MyWb.Range("K" & i)) Or IsEmpty(MyWb.Range("L" & i)) Or IsEmpty(MyWb.Range("N" & i)) Or IsEmpty(MyWb.Range("O" & i)) Or IsEmpty(MyWb.Range("P" & i)) Or IsEmpty(MyWb.Range("R" & i)) Or IsEmpty(MyWb.Range("T" & i)) Or IsEmpty(MyWb.Range("U" & i)) Or IsEmpty(MyWb.Range("X" & i)) Then
            Dim missdata
            missdata = MsgBox("You will need to enter topics before saving", vbOKOnly, "Missing data")
           Cancel = True
           Exit For
        End If
    End If
End If
Next i '??????
exitHandler:
Application.EnableEvents = True
ThisWorkbook.Worksheets("codes").Protect Password:="000"
End Sub

Answer 1

您可以尝试：

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim sh As Worksheet
    Dim rng As Range
    Dim SelectedRange As Range
    Dim LastRow As Long

    Application.EnableEvents = False

    Set sh = ThisWorkbook.Sheets("codes")
    sh.Unprotect Password:="000"

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

    Set SelectedRange = sh.Range("A8:B" & LastRow & ", E8:H" & LastRow & ", J8:L" & LastRow & ", N8:P" & LastRow & ", R8:R" & LastRow & ", T8:U" & LastRow & ", X8:X" & LastRow)

    For Each rng In SelectedRange
        If rng.Value = "" Then
            Cancel = True
            rng.Interior.ColorIndex = 3 'Here the code will fill de cell with color red
        End If
    Next rng

    If Cancel Then MsgBox "You will need to enter topics before saving", vbOKOnly, "Missing data"

    Application.EnableEvents = True
    sh.Protect Password:="000"
End Sub

在vba上保存验证之前

1 个答案: