Ajuda Macro Excel VBA

[Rik]

Power Member
Boa tarde,

O objectivo da macro é selecionar a "população", indicar a amostra (vamos imaginar 10), e ele sozinho vai dar 10 random neste caso números de telemoveis.

Porém antes de deixar a amostra na coluna H, ele vai à coluna C verificar se da amostra que efetuou algum desses números está lá.

Problema:

Neste momento o que faz é, se tiver um número igual dá apenas a amostra 9.

Pretendido é, ele verifica que na coluna C está um número igual. E automaticamente vai buscar outro random qualquer até ter um que não seja igual ao da coluna C... Mas no fim irá sempre dar a amostra de 10 que eu pedi (sem incluir os numeros que estavam na coluna C).

Aqui fica o código:

Sub Vodafone_sample()

Dim Population As Range
Dim lastRow As Long, firstRow As Long
Dim sampleSize As Long
Dim unique As Boolean
Dim uniqueC As Boolean
Dim I As Long, d As Long, n As Long, I2 As Long
Dim a As String

Sheets("Sheet1").Range("G:G").Clear
Sheets("Sheet1").Range("H:H").Clear
Set Population = Application.InputBox("Selecionar População", Type:=8)
sampleSize = Application.InputBox("Indique Valor para Amostra", Type:=1)

If Population.Count < sampleSize Then
MsgBox "Amostra não pode ser maior que a população", vbOKOnly + vbInformation
Exit Sub
End If

Set p = Population
lastRow = p.Rows.Count + p.Row - 1
firstRow = p.Row
I2 = 1
For I = 1 To sampleSize
Do

unique = True
uniqueC = True
n = Application.WorksheetFunction.RandBetween(firstRow, lastRow)



For d = 1 To I - 1
If Cells(d, 7) = n Then
unique = False
Exit For
End If
Next d

d = 1

a = Application.WorksheetFunction.Index(Population, n)

Do While d > 0
If Cells(d, 3) = a Then
uniqueC = False
d = 0
ElseIf Cells(d, 3) = "" Then
d = 0
Else
d = d + 1
End If
Loop

If unique = True Then
Exit Do
End If

Loop

If uniqueC = True Then
Sheets("Sheet1").Select
Cells(I2, 7) = n
Cells(I2, 8) = Application.WorksheetFunction.Index(Population, n)
I2 = I2 + 1
End If

Next I

Sheets("Sheet1").Select

End Sub

Cumps
 
Back
Topo