Sub sbZufzahl()
Dim liZufzahl As Integer
Sheets(1).Range("A1:A10").Value = ""
Do Until fcIsEmpty = False
Randomize
liZufzahl = Int((10 * Rnd))
sbOnly liZufzahl
Loop
End Sub
Function fcIsEmpty() As Boolean
Dim liRow As Integer
For liRow = 1 To 10
If Sheets(1).Range("A" & liRow).Value = "" Then
fcIsEmpty = True
Exit For
End If
Next
End Function
Sub sbOnly(ByVal zufzahl As Integer)
Dim liRow As Integer, lboTreffer As Boolean, liNext As Integer
If Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row = 1 And Sheets(1).Range("A1").Value = "" _
Then
liNext = 1
Else
liNext = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1
End If
For liRow = 1 To 10
If Sheets(1).Range("A" & liRow).Value = zufzahl And _
Sheets(1).Range("A" & liRow).Value "" Then
lboTreffer = True
Exit For
End If
Next
If lboTreffer = False Then
Sheets(1).Range("A" & liNext).Value = zufzahl
End If
End Sub
Sub ZufallszahlenSpalteA10()
Dim lngZahl(1 To 10), lngZ As Long
For lngZ = LBound(lngZahl) To UBound(lngZahl)
Randomize Timer
lngZahl(lngZ) = Rnd()
Next
For lngZ = LBound(lngZahl) To UBound(lngZahl)
Cells(lngZ, 1) = Application.Match(Application.Small(lngZahl, lngZ), lngZahl, 0)
Next
End Sub
Option Explicit
Sub RandomUniqueNumbers()
Dim i&, r&, lngRes&()
Dim hsh As Object, vntKeys
Const CNT As Long = 10
Columns(1).Clear
ReDim lngRes(CNT - 1)
Set hsh = CreateObject("Scripting.Dictionary")
For i = 0 To CNT - 1
hsh(i) = 0
Next
Randomize
For i = 0 To CNT - 1
r = Int(hsh.Count * Rnd)
vntKeys = hsh.Keys
lngRes(i) = vntKeys(r)
hsh.Remove vntKeys(r)
Next
Cells(1, 1).Resize(CNT) = Application.Transpose(lngRes)
End Sub
With Range("A1:B10")
.Columns(1).FormulaLocal="=Zeile()-1"
.Columns(2).FormulaLocal="=Zufallszahl()"
.formula = .value
.Sort Key1:=.Cells(1,2), order1:=xlascending, Header:=xlno
.Columns(2).ClearContents
End with
Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden
Suche nach den besten AntwortenEntdecke unsere meistgeklickten Beiträge in der Google Suche
Top 100 Threads jetzt ansehen