VB Добавить входное сообщение путем проверки данных во все выбранные ячейки

Question

, когда я жду входного сообщения с заголовком при нажатии на ячейку, однако я не могу добиться этого с кодом VB, который у меня есть сейчас. Ребята, не могли бы вы помочь? Заранее спасибо

Sub SelectAllNonBlankCells()
    Dim objUsedRange As Range
    Dim objRange As Range
    Dim objNonblankRange As Range

    Set objUsedRange = Application.ActiveSheet.UsedRange

    For Each objRange In objUsedRange
        If Not (objRange.Value = "") Then
           If objNonblankRange Is Nothing Then
              Set objNonblankRange = objRange
           Else
              Set objNonblankRange = Application.Union(objNonblankRange, objRange)
           End If
        End If
    Next

    With objNonblankRange.Validation
        .Delete
        .Add Type:=xlValidateCustom, Operator:=xlEqual, Formula1:="="""
        .IgnoreBlank = True
        .InputTitle = "Title"
        .InputMessage = "Enter message"
    End With

End Sub

Answer 1

Кажется, вам не хватает двух двойных кавычек. поэтому строка должна выглядеть следующим образом:

.Add Type:=xlValidateCustom, Operator:=xlEqual, Formula1:="="""""

Это предполагает, что вы ожидаете, что проверенные поля будут пустыми. Поскольку кавычка является специальным символом, вам нужно поместить его дважды, чтобы интерпретировать как строку.

Если вы не хотите ничего проверять, а просто добавляете входное сообщение, вы можете использовать условие, например:

 .Add Type:=xlValidateCustom, Formula1:="=(1=1)"

Answer 2

Чтобы достичь этого, вам нужно захватить событие Worksheet_SelectionChange. Попробуйте выполнить следующую процедуру:

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim objUsedRange As Range
Dim objNonblankRange As Range

Set objUsedRange = Application.ActiveSheet.UsedRange

If Selection.Count = 1 Then
    If Selection.Value = "" Then
         If objNonblankRange Is Nothing Then
             Set objNonblankRange = Selection
         Else
             Set objNonblankRange = Application.Union(objNonblankRange, Selection)
         End If
    With objNonblankRange.Validation
        .Delete
        .Add Type:=xlValidateCustom, Operator:=xlEqual, Formula1:="="""""
        .IgnoreBlank = True
        .InputTitle = "Title"
        .InputMessage = "Enter message"
    End With
    End If
End If
End Sub

. Эту процедуру необходимо добавить на лист, чтобы она работала, поэтому щелкните правой кнопкой мыши вкладку «Таблица данных» и выберите «Показать код». Скопируйте туда.

Надеюсь, это поможет!