Bom dia, tenho a seguinte macro:
Sub Sortear()
Dim V() 'Vetor
Dim CONT As Integer 'Contador
Dim I As Integer 'Índice do vetor
Dim QUANT_SORT As Integer 'Recebe o valor de quantos Nº aleatórios serão gerados
Dim NUM_SORT As Integer 'Recebe um número sorteado
Dim LIN As Integer 'Determina em que linha o Nº aleatório será colocado
Dim REP As Integer 'Repetidor
Dim VAL_MIN As Integer 'Recebe o valor mínimo na faixa de números
Dim VAL_MAX As Integer 'Recebe o Valor máximo na faixa de números
Dim FAIXA_SORT As Integer 'Faixa de valores possíveis ao sorteio
ActiveSheet.Name = "Sorteio"
On Error GoTo SAIDA
[E6:E65536].ClearContents
Range("E6:E65536").Font.Bold = True
Range("E6:E65536").Font.Size = 10
INICIO:
VAL_MIN = InputBox("Qual será o MENOR número possível nesse sorteio?")
VAL_MAX = InputBox("Qual será o MAIOR número possível desse sorteio?")
CHECA_VALOR_MAX:
If VAL_MAX <= VAL_MIN Then
If MsgBox("Você deve digitar um número MAIOR para o valor máximo ou alterar o valor mínimo. O Valor mínimo atual é " & VAL_MIN & ". Deseja Alterará-lo?", vbQuestion + vbYesNo + vbApplicationModal + vbDefaultButton1) = vbYes Then
VAL_MIN = InputBox("Corrija o valor mínimo para o sorteio.")
If VAL_MAX <= VAL_MIN Then
GoTo CHECA_VALOR_MAX
End If
Else
VAL_MAX = InputBox("Nesse caso digite um valor MAIOR que " & VAL_MIN & ". O valor máximo atual é " & VAL_MAX & ".")
If VAL_MAX <= VAL_MIN Then
GoTo CHECA_VALOR_MAX
End If
End If
End If
FAIXA_SORT = VAL_MAX - VAL_MIN + 1
QUANT_SORT = InputBox("Quantos números você deseja sortear?")
CHECA_FAIXA:
If QUANT_SORT > FAIXA_SORT Then
QUANT_SORT = InputBox("A quantidade de sorteios supera o valor máximo de números possíveis a serem sorteados sem repetições. Por favor corrija para um número MENOR ou IGUAl a " & FAIXA_SORT & ".")
GoTo CHECA_FAIXA
End If
If VAL_MAX = VAL_MIN + 1 Then
If MsgBox("Você determinou uma faixa muito estreita para a realização de um sorteio. Deseja Alterar os dados?", vbExclamation + vbYesNo + vbApplicationModal + vbDefaultButton1) = vbYes Then
GoTo INICIO
Else
MsgBox "Não é possível realizar um sorteio com os números dados.", vbOKOnly + vbApplicationModal + vbCritical
GoTo SAIDA
End If
End If
Randomize
For LIN = 1 To QUANT_SORT
I = I + 1
ReDim Preserve V(I)
REPETE:
NUM_SORT = Int(rnd * VAL_MAX + VAL_MIN)
REP = 0
For CONT = I - LIN To I
If NUM_SORT = V(CONT) Or NUM_SORT > VAL_MAX Then
REP = 1
End If
Next
If REP = 1 Then
GoTo REPETE
Else
V(I) = NUM_SORT
End If
Next
I = 0
For LIN = 6 To QUANT_SORT
I = I + 1
Cells(LIN, 5) = V(I)
Next LIN
SAIDA:
ActiveWorkbook.Worksheets("Sorteio").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sorteio").Sort.SortFields.Add Key:=Range( _
"E6:E55"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Sorteio").Sort
.SetRange Range("E6:E56")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
Ele está funcionando normal, porém está sorteando 5 números a menos (o número de linhas que usei para criar o cabeçalho, borda, etc.) do que o usuário especifica.
Gostaria que alguém me ajudasse a encontrar aonde está o erro, se possível...
Muito obrigada pela atenção.
"Only those who will risk going too far can possibly find out how far one can go."
Postado : 24/08/2012 7:38 am