vielen dank im voraus
A | B | C | |
1 | |||
2 | |||
3 | |||
4 | |||
5 | |||
6 | |||
7 | |||
8 | |||
9 | |||
10 |
Sub Zufall()
Dim i As Integer
Application.ScreenUpdating = 0
Cells(1, 1) = Int(9000000 + Rnd * 1000000)
For i = 2 To 5000
Do
Cells(i, 1) = Int(9000000 + Rnd * 1000000)
Loop Until Cells(i, 1) Cells(i - 1, 1)
Next
Application.ScreenUpdating = -1
End Sub
Public Sub DoppelteSuchen()
Dim lZeile As Long
Application.ScreenUpdating = 0
For lZeile = 1 To 5000
If Application.WorksheetFunction.CountIf(Columns(1), Range("A" & lZeile).Value) > 1 Then
Range("B" & lZeile).Value = "doppelt " & _
Application.WorksheetFunction.CountIf(Columns(1), Range("A" & lZeile).Value)
End If
Next lZeile
Application.ScreenUpdating = -1
End Sub
Gruß Peter
Sub ZufList()
Dim arrZ, ii As Long
arrZ = Zufallsliste(5000)
For ii = 1 To 5000
arrZ(ii) = arrZ(ii) + 9000000
Next ii
Cells(1, 1).Resize(5000) = Application.Transpose(arrZ)
End Sub
Function Zufallsliste(intI As Integer)
' Zahlen 1 bis Anzahl ohne Wiederholungen - ingUR 04.12.2006
' www.herber.de/forum/archiv/824to828/t825988.htm
Dim ii As Long, iLosNr As Long, arrOK() As Boolean, arrLos() As Long
ReDim arrOK(1 To intI), arrLos(1 To intI)
Randomize
For ii = 1 To intI
Do
iLosNr = Int((intI * Rnd) + 1)
If Not arrOK(iLosNr) Then arrLos(ii) = iLosNr: arrOK(iLosNr) = True
Loop Until arrLos(ii) > 0
Next
Zufallsliste = arrLos
End Function
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort