Question

我正在努力学习一些VBA代码和BeforeSave方法。我一直在论坛上，但无法找到我需要的答案，所以请一定帮助。我的问题！在保存时，我需要代码查看“表”（名为Claims）的列H（名为Claim USD）的数值，然后如果任何单元格有值，则查看第I列（命名为Claim Date）并确保那里有一个日期。我已经验证了第I列的数据，只接受日期条目。

我已经找到了下面的代码，并测试了它的功能并且它的工作原理。我只是不确定如何合并我的元素。有谁能给我一些帮助？

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

Dim rsave As Range
Dim cell As Range
Set rsave = Sheet2.Range("I8,I500")

For Each cell In rsave

If cell = "" Then

Dim missdata
missdata = MsgBox("missing data", vbOKOnly, "Missing Data")
Cancel = True
cell.Select

Exit For

End If

Next cell

End Sub

Answer 1

我很确定我破解了它，无论如何它都有效。下面的代码（对于那些感兴趣的人!!）

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

     Dim rsave As Range
     Dim cell As Range

     Set rsave = Sheet2.Range("Table1[Estimated Claim (USD)]")

     For Each cell In rsave

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

          Dim missdata
          missdata = MsgBox("Missing Data - Enter the Date for WorkBook to Save", vbOKOnly, "Missing Data")
          Cancel = True
          cell.Offset(0, 1).Select

      Exit For

      End If

      Next cell

 End Sub

我现在必须通过其他三个列标题来检查相同的条件。如果有人知道更快的代码方法。非常感谢帮助！

Answer 2

我已经创建了一个自定义类进行验证，请参阅here。对于你想要做的事情来说这是非常过分的，但它允许你做的是捕获所有有错误的单元格，并用它们做你想做的事情。您可以下载并导入2类模块Validator.cls和ValidatorErrors.cls然后使用以下

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
  Unflag
  Dim rsave As Range
  Dim rcell As Range
  Dim v AS New Validator

  Set rsave = Sheet2.Range("Table1[Estimate Date]")
  with v
    For Each rcell In rsave
      .validates rcell,rcell.address
         .presence
    Next rcell
 End With
 If not(v.is_valid) Then
     FlagCollection v.errors
     MsgBox("Missing data in " & v.unique_keys.Count & " Cell(s).", vbOKOnly, "Missing Data")
     Cancel = True
 End IF
 Set v = Nothing
End Sub

Public Sub flag(flag As String, comment As String)
  Dim comments As String
  If has_comments(flag) Then
   comments = Sheet2.Range(flag).comment.Text & vbNewLine & comment
  Else
    comments = comment
  End If
  Sheet2.Range(flag).Interior.Color = RGB(255, 255, 102)
  Sheet2.Range(flag).ClearComments
  Sheet2.Range(flag).AddComment comments
End Sub

Public Sub FlagCollection(all_cells As Collection)
  Dim flag_cell As ValidatorError

  For Each flag_cell In all_cells
    flag flag_cell.field, flag_cell.error_message
  Next flag_cell
End Sub

Public Sub Unflag()
  Cells.Select
  Selection.Interior.ColorIndex = xlNone
  Selection.ClearComments
End Sub

Public Function has_comments(c_cell As String) As Boolean
   On Error Resume Next
   Sheet1.Range(c_cell).comment.Text
   has_comments = Not (CLng(Err.Number) = 91)
End Function

这将标记每个具有黄色错误的字段，并添加注释以确定问题是什么，您还可以确定一种方法来告诉用户确切的错误使用位置v.uniq_keys返回单元格地址的集合'对存在的验证失败。

VBA BeforeSave检查缺失数据

2 个答案: