AW: Treffer zählen
29.10.2003 02:28:54
Reinhard
Hi Milan,
ich hab mir mit dem ersten Makro (Fuellen) deine tab mal mit 20000 Zeilen nachgestellt.
Ohne Überprüfung ob da Zahlen doppelt sind, denn das spielt ja erstmal keine Rolle, da es um Spalte E geht.
Danach die beiden anderen Makros, die du benutzen kannst, füllen die Spalte E mit den Werten auf, das braucht dann zusammen so 2-4 Minuten. Erst HilfsSpaltenErzeugen aufrufen, dann Spalte-E-füllen aufrufen.
In den Hilfspalten steht drin wie oft die Zahlen 1-49 jeweils im siebenspaltigen Bereich vorkommen.
Gruß
Reinhard
Sub Fuellen()
'ca. 12 Minuten
Application.ScreenUpdating = False
For n = 1 To 20000
Cells(n, 1) = Int(Rnd * 49) + 1
Cells(n, 2) = Int(Rnd * 49) + 1
Cells(n, 3) = Int(Rnd * 49) + 1
Cells(n, 8) = Int(Rnd * 49) + 1
Cells(n, 9) = Int(Rnd * 49) + 1
Cells(n, 10) = Int(Rnd * 49) + 1
Cells(n, 11) = Int(Rnd * 49) + 1
Cells(n, 12) = Int(Rnd * 49) + 1
Cells(n, 13) = Int(Rnd * 49) + 1
Cells(n, 14) = Int(Rnd * 49) + 1
Next n
Application.ScreenUpdating = True
End Sub
Sub HilfsspaltenErzeugen()
' ca 2 Minuten
Application.ScreenUpdating = False
'Dim z(49) As Long
For n = 1 To 49
Cells(n, 20) = n
Zähler = 0
With Range(Cells(1, 8), Cells(20000, 14))
Set ze = .Find(What:=n, LookAt:=xlWhole, MatchCase:=True)
If Not ze Is Nothing Then
Adresse = ze.Address
Do
Zähler = Zähler + 1
Set ze = .FindNext(ze)
Loop While Not ze Is Nothing And ze.Address <> Adresse
End If
Cells(n, 21) = Zähler
End With
Next n
Application.ScreenUpdating = True
End Sub
Sub Spalte_E_Fuellen()
' ca 2 Minuten
Application.ScreenUpdating = False
Dim z(49) As Long
For n = 1 To 49
z(n) = Cells(n, 21)
Next n
For n = 1 To 20000
Cells(n, 5) = z(Cells(n, 1).Value) + z(Cells(n, 2).Value) + z(Cells(n, 3).Value)
Next n
Application.ScreenUpdating = True
End Sub