Предупреждение VBA, когда выбранные ячейки не равны 5 и смежны

Question

Мой макрос Vb выполняет следующие действия: я выбираю 5 смежных ячеек, запускаю свой макрос и получаю 5 статических случайных чисел от 1 до 50; Работает отлично; Мне нужно предупреждение, когда выделенные ячейки не являются смежными и не равны 5. Ячейки выбора должны быть 5 и смежными. Понятия не имею, как и где я должен поставить предупреждение. Спасибо!

Sub loto()
    from = 1
    until = 50
 Selection.ClearContents
    For Each cell In Selection.Cells
        If WorksheetFunction.CountA(Selection) = (until - from + 1) Then Exit For
        Do
            rndNumber = Int((until - from + 1) * Rnd() + from)
        Loop Until Selection.Cells.Find(rndNumber, LookIn:=xlValues, lookat:=xlWhole) Is Nothing
        cell.Value = rndNumber
    Next
End Sub

Answer 1

Чтобы ответить на ваш прямой вопрос:

If Selection.Areas.Count > 1 Or Selection.Cells.Count <> 5 Then

Точнее, мы можем немного очистить ваш код, чтобы удалить лишние строки и добавить некоторые дополнительные проверки. Например, вы выдадите ошибку, если пользователь выберет фигуру, а затем запустит код.

Sub loto()

    'Declarations
    Const minValue As Integer = 1
    Const maxValue As Integer = 50
    Const cellCount As Integer = 5
    Dim rng As Range
    Dim cell As Range
    Dim errorMessage As String
    errorMessage = "You must select " & cellCount & " contiguous cells!"

    'Check that the selection is a range of cells and not some object
    On Error Resume Next
        Set rng = Selection
    On Error GoTo 0
    If rng Is Nothing Then
        MsgBox errorMessage, vbExclamation, "Error"
        Exit Sub
    End If

    'Check that five contiguous cells are selected
    If rng.Areas.Count > 1 Or rng.Cells.Count <> cellCount Then
        MsgBox errorMessage, vbExclamation, "Error"
        Exit Sub
    End If

    'Loop through each and add values
    rng.ClearContents
    For Each cell In rng.Cells
        Do
            cell.Value = Int((maxValue - minValue + 1) * Rnd() + minValue)
        Loop Until WorksheetFunction.CountIf(rng, cell.Value) = 1
    Next

End Sub