Проверка VBA BeforeSave для получения отсутствующих данных

Question

Я борюсь с кодом VBA и методологией BeforeSave. Я был на всех форумах, но не могу найти ответ, который мне нужен, так что, пожалуйста, понравится какая-то помощь. Мой вопрос! При сохранении мне нужен код для просмотра столбца H (с именем Claim USD) «таблицы» (с именем Claims) для числового значения, а затем, если какая-либо из ячеек имеет значение, затем посмотрите на столбец I (named 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

Я создал специальный класс для проверки, см. 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, который возвращает коллекцию адресов ячеек, которые не позволяют проверить наличие.

Answer 2

Я уверен, что я взломал его, ну он все равно работает. Код ниже (для тех, кто заинтересован в любом случае !!)

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 

Я теперь получил петлю этого через три других заголовков столбцов проверки для тех же критериев. Если кто-то знает более быстрый метод кода. Поблагодарите за помощь!