Weil diese beiden Zahlen in 440 prognostiziert wurden
mit einer Laufzeit von 5 Ziehungen (5 = AM1 Wert)
also für 440,441,442,443,444
Wenn in 440 bis 444 eine oder beide Zahlen gezogen werden,
dann wird die Zahl grau.
Wenn ab 445 also über 5 dann wird die Zahl gelb.
Die 15 kam in 447 also wird sie gelb
Die 39 kam in 442 also wird sie grau
In 440 als die 15 und 39 prognostiziert wurden
waren also diese und andere Zahlen noch offen.
Nochmals etwas grundsätzliches:
- Wir sehen in 441 haben wir 3 farblich markierte / Hintergrundfarbe
egal welche grau oder gelb mind. 3
- nun wollen wir den AN Wert für 441 errechnen
dazu muss alles inkl. 441 im Bereich D:I entfernt werden
da wir vor der Ziehung nicht wissen konnten was am 21.03.2015 gezogen wird.
Lösche 441 bis Ende Datei im Bereich D:I
Wenn ich dann auf AN Werte berechnen Schritt1 klicke
sind die 15 und 39 noch offen - oder?
Besser gesagt ... insgesamt 14 Zahlen noch offen.
For iavntDaten1 = LBound(avntDaten, 1) To UBound(avntDaten, 1)
For iavntDaten2 = LBound(avntDaten, 2) To UBound(avntDaten, 2)
If avntDaten(iavntDaten1, iavntDaten2) = vntSuchwert Then
avntErgebniswert(iavntSuchwert1, iavntSuchwert2) = iavntDaten1
blnFund = True: Exit For
End If
Next
If blnFund Then Exit For
Next
If blnFund Then
rngSuchwert.Cells(iavntSuchwert1, iavntSuchwert2).Interior.Color = RGB(192, 192, 192)
rngDaten.Cells(iavntDaten1, iavntDaten2).Interior.Color = RGB(192, 192, 192)
blnFund = False
Else
Set rngFund = Range(rngDaten.Rows(1), rngDatenLastRow).Find(vntSuchwert, , xlValues, xlWhole)
If Not rngFund Is Nothing Then
If rngFund.Interior.Color <> RGB(192, 192, 192) Then
rngFund.Interior.Color = vbYellow
End If
For iavntDaten1 = LBound(avntDaten, 1) To UBound(avntDaten, 1)
For iavntDaten2 = LBound(avntDaten, 2) To UBound(avntDaten, 2)
If avntDaten(iavntDaten1, iavntDaten2) = vntSuchwert Then
avntErgebniswert(iavntSuchwert1, iavntSuchwert2) = iavntDaten1
blnFund = True: Exit For
End If
Next
If blnFund Then Exit For
Next
If blnFund Then
rngSuchwert.Cells(iavntSuchwert1, iavntSuchwert2).Interior.Color = RGB(192, 192, 192)
rngDaten.Cells(iavntDaten1, iavntDaten2).Interior.Color = RGB(192, 192, 192)
blnFund = False
Else
Set rngFund = Range(rngDaten.Rows(1), rngDatenLastRow).Find(vntSuchwert, , xlValues, xlWhole)
If Not rngFund Is Nothing Then
If rngFund.Interior.Color <> RGB(192, 192, 192) Then
rngFund.Interior.Color = vbYellow
If rngFund.Row = 127 Then Stop
End If
Set rngDatenLastRow = Nothing
Set rngSuchwert = Nothing
End Sub
Sub zählen2()
Dim lngLetzteZeile As Long
Dim i As Long, j As Long, k As Long
Columns("M").ClearContents
lngLetzteZeile = LetzteBeschriebeneZeile(Range("D:I"))
For i = 1 To lngLetzteZeile
For j = 4 To 9
If Cells(i, j).Interior.ColorIndex <> xlColorIndexNone Then
k = k + 1
End If
Next j
If k >= 3 Then Cells(i, 13) = Application.Max(Columns("M")) + 1
k = 0
Next i
End Sub
Public Function LetzteBeschriebeneZeile(ByRef rngBereich As Range) As Long
On Error Resume Next
LetzteBeschriebeneZeile = rngBereich.Find("*", , xlFormulas, xlWhole, xlByRows, xlPrevious).Row
End Function
Folgenden in ein andres Modul:
Code:
Sub zählen()
Dim i As Long, j As Long, pp As Long
Dim lngZd As Long, lngZZ
For i = 1 To lngZZ
For j = 15 To 26
If Cells(i, j) <> "" Then
If Cells(i, j).Interior.Color = 52479 Then
If InStr(1, strgSammlung, Format(Cells(i, j), "00"), vbTextCompare) = 0 Then strgSammlung = strgSammlung & "#" & Format(Cells(i, j), "00")
End If
End If
Next j
Next i
If UBound(Split(strgSammlung, "#")) > 0 Then
Cells(lngZZ, 40) = UBound(Split(strgSammlung, "#"))
Else
Cells(lngZZ, 40) = 0
End If
strgSammlung = ""
Next pp
Application.ScreenUpdating = True
End Sub
Public Function LetzteBeschriebeneZeile(ByRef rngBereich As Range) As Long
On Error Resume Next
LetzteBeschriebeneZeile = rngBereich.Find("*", , xlFormulas, xlWhole, xlByRows, xlPrevious).Row
End Function
Und Du führst nur den letzten Code aus, sonst nichts!!!
Wenn es funktioniert, dann kannst Du die Benennungen der Prozeduren später anpassen.
Wenn irgendwo Select oder Debug.Print auftauchen sollte, diese Zeilen löschen, wenn dann waren sie zu Testzwecken drin.
Gruß Atilla
Folgende(r) 1 Nutzer sagt Danke an atilla für diesen Beitrag:1 Nutzer sagt Danke an atilla für diesen Beitrag 28 • Angelina
22.03.2016, 17:57 (Dieser Beitrag wurde zuletzt bearbeitet: 22.03.2016, 17:58 von Angelina.)
hallo atilla,
kein Problem ... nur langsam ... habe Zeit ... bin ja noch jung :19:
dann kann ich weiter testen - ohne Daten im
Bereich D:I
und
Bereich O:Z
und
Bereich AA:AL
ist das etwas schwer
gefällt mir in der Spalte M das hier aufgezählt wird wieviel mind. 3 farbliche haben
wenn jetzt noch die dazugehörige Spalte A,B,C automatisch rot wird ... :15:
Vom Gefühl werde ich sagen das war ein Volltreffer ... aber ich muss erst noch testen... testen...
wenn die Daten wieder angezeigt werden.
Werden die Zahlen, z.B. welche 14 Zahlen das sind im VBCode irgendwo hinterlegt?
Übrigens:
Den Jackpot wird man damit nicht gewinnen.
Möchte ich auch nicht.
Kleinvieh macht auch Mist.
Das ist eher was für Buchmacherwetten!
For iavntDaten1 = LBound(avntDaten, 1) To UBound(avntDaten, 1)
For iavntDaten2 = LBound(avntDaten, 2) To UBound(avntDaten, 2)
If avntDaten(iavntDaten1, iavntDaten2) = vntSuchwert Then
avntErgebniswert(iavntSuchwert1, iavntSuchwert2) = iavntDaten1
blnFund = True: Exit For
End If
Next
If blnFund Then Exit For
Next
If blnFund Then
rngSuchwert.Cells(iavntSuchwert1, iavntSuchwert2).Interior.Color = RGB(192, 192, 192)
rngDaten.Cells(iavntDaten1, iavntDaten2).Interior.Color = RGB(192, 192, 192)
blnFund = False
Else
Set rngFund = Range(rngDaten.Rows(1), rngDatenLastRow).Find(vntSuchwert, , xlValues, xlWhole)
If Not rngFund Is Nothing Then
If rngFund.Interior.Color <> RGB(192, 192, 192) Then
rngFund.Interior.Color = vbYellow
End If
Set rngDatenLastRow = Nothing
Set rngSuchwert = Nothing
End Sub
Public Function LetzteBeschriebeneZeile(ByRef rngBereich As Range) As Long
On Error Resume Next
LetzteBeschriebeneZeile = rngBereich.Find("*", , xlFormulas, xlWhole, xlByRows, xlPrevious).Row
End Function
Folgenden in ein anderes Modul:
Code:
Sub zählen()
Dim i As Long, j As Long, pp As Long
Dim lngZd As Long, lngZZ
Dim strgSammlung As String
Dim varFeld_D_I
Dim varFeld_O_AL
Dim strgAdress_D_I As String
Dim strgAdress_O_Al As String
For i = 1 To lngZZ
For j = 15 To 26
If Cells(i, j) <> "" Then
If Cells(i, j).Interior.Color = 52479 Then
If InStr(1, strgSammlung, Format(Cells(i, j), "00"), vbTextCompare) = 0 Then strgSammlung = strgSammlung & "#" & Format(Cells(i, j), "00")
End If
End If
Next j
Next i
If UBound(Split(strgSammlung, "#")) > 0 Then
Cells(lngZZ, 40) = UBound(Split(strgSammlung, "#"))
Else
Cells(lngZZ, 40) = 0
End If
strgSammlung = ""
Next pp
Range(strgAdress_D_I) = varFeld_D_I
Range(strgAdress_O_Al) = varFeld_O_AL
XLPHAN
Application.ScreenUpdating = True
End Sub
Sub zählen2()
Dim lngLetzteZeile As Long
Dim i As Long, j As Long, k As Long
Columns("M").ClearContents
lngLetzteZeile = LetzteBeschriebeneZeile(Range("D:I"))
For i = 1 To lngLetzteZeile
For j = 4 To 9
If Cells(i, j).Interior.ColorIndex <> xlColorIndexNone Then
k = k + 1
End If
Next j
If k >= 3 Then
Cells(i, 13) = Application.Max(Columns("M")) + 1
Range(Cells(i, 1), Cells(i, 3)).Interior.ColorIndex = 3
End If
k = 0
Next i
End Sub
Public Function LetzteBeschriebeneZeile(ByRef rngBereich As Range) As Long
On Error Resume Next
LetzteBeschriebeneZeile = rngBereich.Find("*", , xlFormulas, xlWhole, xlByRows, xlPrevious).Row
End Function
Nur die Prozedur Sub zählen() ausführen.
Gruß Atilla
Folgende(r) 1 Nutzer sagt Danke an atilla für diesen Beitrag:1 Nutzer sagt Danke an atilla für diesen Beitrag 28 • Angelina
22.03.2016, 19:34 (Dieser Beitrag wurde zuletzt bearbeitet: 22.03.2016, 19:34 von schauan.)
Hallo Angelina,
wieso sind denn jetzt die 15 und die 39 offen? Wenn ich 441 auszähle, habe ich die 15 in 424 markiert und die 39 in 422.
Offen sind bei mir für die Auszählung in Zeile 23 folgende 11 Zahlen.
Zuerst kommt in dieser kleinen Aufstellung die Zeilennummer für den Eintrag in AN, dann die Zahl und zuletzt die Zeile der Zahl, die ich zur Bewertung heranziehe, um keine doppelte Bewertung zu erreichen.
Die komplette Zahlenliste hast Du bei Ausführung des codes auch im Direktfenster im VBA-Editor.
du hattest noch gefragt, ob die Zahlen bekannt sind.
Das sind sie und wenn Du die Prozedur Sub zählen() mit folgender ersetzt, dann werden diese in Spalte N ausgegeben. (Spaltenbreite von N musst Du manuell anpassen, kann aber auch per Code erledigt werden, wenn gewünscht)
Code:
Sub zählen()
Dim i As Long, j As Long, pp As Long
Dim lngZd As Long, lngZZ
Dim strgSammlung As String
Dim varFeld_D_I
Dim varFeld_O_AL
Dim strgAdress_D_I As String
Dim strgAdress_O_Al As String
For i = 1 To lngZZ
For j = 15 To 26
If Cells(i, j) <> "" Then
If Cells(i, j).Interior.Color = 52479 Then
If InStr(1, strgSammlung, Format(Cells(i, j), "00"), vbTextCompare) = 0 Then strgSammlung = strgSammlung & "#" & Format(Cells(i, j), "00")
End If
End If
Next j
Next i
If UBound(Split(strgSammlung, "#")) > 0 Then
Cells(lngZZ, 40) = UBound(Split(strgSammlung, "#"))
Cells(lngZZ, 14) = Replace(Join(Split(strgSammlung, "#"), ", "), ", ", "", 1, 1)
Else
Cells(lngZZ, 40) = 0
End If
strgSammlung = ""
Next pp
Range(strgAdress_D_I) = varFeld_D_I
Range(strgAdress_O_Al) = varFeld_O_AL
XLPHAN
Application.ScreenUpdating = True
End Sub
Gruß Atilla
Folgende(r) 1 Nutzer sagt Danke an atilla für diesen Beitrag:1 Nutzer sagt Danke an atilla für diesen Beitrag 28 • Angelina
hier wäre mal noch die Liste mit Treffern für die Zeile 23. Du müsstest übrigens immer noch in AO1 die Farbe aus einer leeren Zelle von O:Z übernehmen.
23 15 22 Treffer in $F$6
23 39 22 Treffer in $H$4
23 4 21
23 10 21
23 32 21
23 19 20 Treffer in $F$3
23 16 19 Treffer in $G$19
23 2 18
23 20 17 Treffer in $E$17
23 30 17
23 3 16 Treffer in $D$18
23 35 16
23 24 15
23 31 15 Treffer in $F$15
23 44 15
23 26 13
23 13 12
23 14 12
23 23 12 Treffer in $E$13
23 25 12 Treffer in $E$12
23 21 11 Treffer in $D$13
23 40 11 Treffer in $H$22
23 7 8 Treffer in $D$9
23 42 3 Treffer in $F$9
23 27 1 Treffer in $G$7
23 49 1 Treffer in $I$10
. \\\|/// Hoffe, geholfen zu haben. ( ô ô ) Grüße, André aus G in T ooO-(_)-Ooo (Excel 97-2019+365)