title image


Smiley Lottozahlenauswertung - Problem mit Array`s
Hi,

entweder bekomme ich die Fehlermeldung: Indexfehler, oder: Überlauf....oder gar kein Ergebnis :-((

Vor Jahren habe ich diese Routine - ich weiß nicht mehr von wem - bekommen, die ich nunmehr doch noch benötige. Excelkenntnisse habe ich mir durch learning by doing erworben, wobei ich bei der Arrayprog. eine Bogen gemacht habe. Leider!

In der Zeile F1:K1 sind die Ziehungszahlen und in der Zelle L1 die Ziehungszahl eingetragen. Die Treffer sollten in der Spalte M ausgegeben werden.

Ich hoffe auf einen Spezialisten, der mir diese Routine derart adaptiert, dass ich sie auch verwenden kann. Ich weiß nur, dass diese (funktionierende) Routine sehr schnell ist und für Spielgemeinschaften mit bis zu 30000 Tipps von Interesse sein könnte.

Ich bedanke mich jede Hilfestellung schon jetzt recht herzlich.



Sub ZiehungsTrefferErmitteln()

Application.ScreenUpdating = False

Worksheets("Auswertung").Activate

Dim lzeile%

lzeile = Cells(Rows.Count, 6).End(xlUp).Row

'Zuerst die vorhandenen Treffer löschen

Range("M5:M" & lzeile).ClearContents



' Max = getippte Lottozahlen

Const max = 7

' lottozahlen 1 bis 7 (6 Lottozahlen + ZZ)

Dim lottozahlen(1 To 7) As Integer

Dim tip(1 To max) As Integer

Dim i, j, k, richtige, tipanzahl As Integer

Dim weiter, naechsterTip As Boolean

Dim ZZ As String

'' Werte für Lottozahlen, Zusatzzahl zuweisen,

'' diese stehen in Zeile 1 des Blattes Auswertung

For i = 1 To 7

lottozahlen(i) = Sheets("Auswertung").Cells(1, i)

Next i

weiter = True

' In Zeile 6 stehen die ersten Lottotips

i = 6

Do While weiter

' Werte des Lottotips i-1 zuweisen

naechsterTip = True

j = 1

Do While naechsterTip

tip(j) = Sheets("Auswertung").Cells(i, j + 1)

j = j + 1

If Sheets("Auswertung").Cells(i, j + 1) = "" Then naechsterTip = False

Loop

'' Tipanzahl: Anzahl der getippten Zahlen

tipanzahl = j - 1

richtige = 0

'' Überprüfung auf Richtige Lottozahl ohne ZusatzZahl

For j = 2 To tipanzahl

For k = 3 To 7

If tip(j) = lottozahlen(k) Then

richtige = richtige + 1



' Einfärben der Richtigen Zahl

Sheets("Auswertung").Cells(i, j + 1).Select

Sheets("Auswertung").Cells(i, j + 1).Font.ColorIndex = 3

End If

Next k

Next j

'' Überprüfung der Zusatzzahl bei 5 Richtigen

ZZ = ""

If richtige = 5 Then

For j = 5 To tipanzahl

If tip(j) = lottozahlen(9) Then _

ZZ = " + ZZ"

Next j

End If

'' Ausgabe des Ergebnis

If richtige >= 3 Then

Sheets("Auswertung").Cells(i, 13) = richtige & ZZ 'Spalte 13 ist M

End If

'' Nächste Zeile und weiter oder Ende!

i = i + 1

If Sheets("Auswertung").Cells(i, 6) = "" Then weiter = False

Loop

End Sub

geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: