Excel VBA Создание входного сообщения проверки диапазона из комментария диапазона

Question

У меня проблемы с тем, чтобы сделать то, что мне кажется простой подпрограммой Excel VBA, у нас есть электронная таблица, где вместо проверочных входных сообщений используются комментарии. Я хотел бы l oop таблицу и заменить все эти комментарии сообщениями проверки.

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

Я сделал попытку, но мне не удается создать входящее сообщение из комментария. Текст. Может кто-нибудь объяснить, почему это идет не так и что я должен изменить?

Спасибо

Sub EditComments()

    Dim rng As Range, cell As Range
    Set rng = Range("A19:AA655")


    For Each cell In rng
        Dim oCell As Range
        Set oCell = cell
        oCell.Select
        With oCell


            If Not .Comment Is Nothing Then
                Dim oComment As Comment
                Set oComment = .Comment

                Dim oValidation As Validation
                Set oValidation = .Validation

                With oCell.Validation
                    .InputMessage = oComment.Text
                End With

                oComment.Delete
            End If

        End With


    Next


End Sub

Answer 1

Давайте попробуем

Sub EditComments()
Application.ScreenUpdating = False
    Dim rng As Range, oCell As Range
    Set rng = Range("A19:AA655")
    For Each oCell In rng
        With oCell
            'check if cell contain comment.
            If Not .Comment Is Nothing Then

              'check if cell not contain dropdown then do something
              If .Validation Is Nothing Then
                 With .Validation
                 .Add Type:=xlValidateInputOnly
                    .InputTitle = "Message"
                    .InputMessage = oCell.Comment.Text
                 End With
              Else 'if contain dropdown
                With .Validation
                    .InputTitle = "Message"
                    .InputMessage = oCell.Comment.Text
                End With
              End If
              .Comment.Delete

              End If

            End If
        End With
    Next
Application.ScreenUpdating = True
End Sub

Пожалуйста, прочитайте: Ссылка