Aviso do VBA quando as células selecionadas não são iguais a 5 e contíguas

0

Minha macro Vb faz o seguinte: Eu seleciono 5 células contíguas, executo minha macro e obtenho 5 números aleatórios estáticos entre 1 e 50; Funciona perfeitamente; Preciso de um aviso quando as células selecionadas não são contíguas e não são iguais a 5. As células selecionadas devem ser 5 e contíguas. Não tenho idéia de como e onde devo colocar o aviso. Obrigado!

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
    
por Emanuel 03.02.2016 / 16:22

1 resposta

1

Para responder à sua pergunta direta:

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

Mais completamente, podemos limpar seu código um pouco para remover linhas externas e adicionar algumas verificações extras. Por exemplo, você terá um erro se o usuário selecionar uma forma e, em seguida, executar o código.

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
    
por 03.02.2016 / 16:37