Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

Ursprüngliche Zahlen finden?
#51
Hallo Angelina,

kannst Du mir erklären, warum die 15 und 39 mitgezählt werden sollen, obwohl sie in D:I bis 441 farblich markiert sind?
Gruß Atilla
Antworten Top
#52
guten morgen atilla,

ja ... sicherlich kann ich das erklären!

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.

LG
Angelina
Antworten Top
#53
Hallo Angelina,

jetzt bekommst Du Deine 14. Ich habe mich extra beeilt, damit Du morgen den Jackpot knacken kannst :19:

Folgenden Code in ein Modul:


Code:
Public Sub XLPHAN_1()
 Dim lngLetzteZeile As Long
 Dim lngSuchZeilenAnzahlMax As Long

 Dim rngSuchwert As Range

 Dim avntSuchwert() As Variant
 Dim iavntSuchwert1 As Long
 Dim iavntSuchwert2 As Long

 Dim rngDaten As Range

 Dim avntDaten() As Variant
 Dim iavntDaten1 As Long
 Dim iavntDaten2 As Long

 Dim vntSuchwert As Variant

 Dim avntErgebniswert() As Variant

 Dim blnFund As Boolean

 Dim rngFund As Range
 Dim rngDatenLastRow As Range

 With Tabelle1
   
     Intersect(.UsedRange, .Range("D:I")).Interior.ColorIndex = xlColorIndexNone
     Intersect(.UsedRange, .Range("O:Z")).Interior.Color = RGB(255, 204, 0)
     Intersect(.UsedRange, .Range("AA:AL")).ClearContents
   
     lngLetzteZeile = LetzteBeschriebeneZeile(.Range("D:AL"))
     If lngLetzteZeile = 0 Then Exit Sub
   
     lngSuchZeilenAnzahlMax = Val(.Range("AM1").Value)
     If lngSuchZeilenAnzahlMax = 0 Then Exit Sub
   
     Set rngDatenLastRow = Intersect(.Range("D:I"), .Rows(lngLetzteZeile))
     Set rngSuchwert = .Range("O1:Z" & lngLetzteZeile)
     avntSuchwert() = rngSuchwert.Value
           
     avntErgebniswert() = .Range("AA1:AL" & lngLetzteZeile).Value
   
     For iavntSuchwert1 = LBound(avntSuchwert, 1) To UBound(avntSuchwert, 1)
       
         Set rngDaten = .Range("D" & iavntSuchwert1).Resize(lngSuchZeilenAnzahlMax, 6)
     
         avntDaten() = rngDaten.Value
       
         For iavntSuchwert2 = LBound(avntSuchwert, 2) To UBound(avntSuchwert, 2)
           
             vntSuchwert = avntSuchwert(iavntSuchwert1, iavntSuchwert2)
           
             If Not IsEmpty(vntSuchwert) Then
           
                 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
                       
                         rngSuchwert.Cells(iavntSuchwert1, iavntSuchwert2).Interior.Color = vbYellow
                     Else
                       
                     End If
                 End If
               
             End If
         Next
       
         Set rngDaten = Nothing
       
     Next
   
     .Range("AA1:AL" & lngLetzteZeile).Value = avntErgebniswert()
 End With

 Erase avntDaten
 Erase avntErgebniswert
 Erase avntSuchwert

 Set rngDatenLastRow = Nothing
 Set rngSuchwert = Nothing
zählen2
End Sub

Public Sub XLPHAN_2()
 Dim lngLetzteZeile As Long
 Dim lngSuchZeilenAnzahlMax As Long

 Dim rngSuchwert As Range

 Dim avntSuchwert() As Variant
 Dim iavntSuchwert1 As Long
 Dim iavntSuchwert2 As Long

 Dim rngDaten As Range

 Dim avntDaten() As Variant
 Dim iavntDaten1 As Long
 Dim iavntDaten2 As Long

 Dim vntSuchwert As Variant

 Dim avntErgebniswert() As Variant

 Dim blnFund As Boolean

 Dim rngFund As Range
 Dim rngDatenLastRow As Range

 With Tabelle1
   
     Intersect(.UsedRange, .Range("D:I")).Interior.ColorIndex = xlColorIndexNone
     Intersect(.UsedRange, .Range("O:Z")).Interior.Color = RGB(255, 204, 0)
     Intersect(.UsedRange, .Range("AA:AL")).ClearContents
   
     lngLetzteZeile = LetzteBeschriebeneZeile(.Range("D:AL"))
     If lngLetzteZeile = 0 Then Exit Sub
   
     lngSuchZeilenAnzahlMax = Val(.Range("AM1").Value)
     If lngSuchZeilenAnzahlMax = 0 Then Exit Sub
   
     Set rngDatenLastRow = Intersect(.Range("D:I"), .Rows(lngLetzteZeile))
     Set rngSuchwert = .Range("O1:Z" & lngLetzteZeile)
     avntSuchwert() = rngSuchwert.Value
           
     avntErgebniswert() = .Range("AA1:AL" & lngLetzteZeile).Value
   
     For iavntSuchwert1 = LBound(avntSuchwert, 1) To UBound(avntSuchwert, 1)
       
         Set rngDaten = .Range("D" & iavntSuchwert1).Resize(lngSuchZeilenAnzahlMax, 6)
     
         avntDaten() = rngDaten.Value
       
         For iavntSuchwert2 = LBound(avntSuchwert, 2) To UBound(avntSuchwert, 2)
           
             vntSuchwert = avntSuchwert(iavntSuchwert1, iavntSuchwert2)
           
             If Not IsEmpty(vntSuchwert) Then
           
                 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
                       
                         rngSuchwert.Cells(iavntSuchwert1, iavntSuchwert2).Interior.Color = vbYellow
                     Else
                       
                     End If
                 End If
               
             End If
         Next
       
         Set rngDaten = Nothing
       
     Next
   
     .Range("AA1:AL" & lngLetzteZeile).Value = avntErgebniswert()
 End With

 Erase avntDaten
 Erase avntErgebniswert
 Erase avntSuchwert

 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

 Dim strgSammlung As String

 lngZd = LetzteBeschriebeneZeile(Range("D:AL"))

 Columns("AN").ClearContents

 XLPHAN_1

 Application.ScreenUpdating = False
 For pp = Application.Max(Columns("M")) To 1 Step -1
   lngZZ = Application.Match(pp, Range(Cells(1, 13), Cells(lngZd, 13)), 0)
   Range(Cells(lngZZ, 4), Cells(lngZd, 9)).ClearContents
   Range(Cells(lngZZ + 1, 15), Cells(lngZd, 38)).ClearContents
   
   XLPHAN_2
     
   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:
  • Angelina
Antworten Top
#54
hallo atilla,

erstmal nochmals großen Dank für deine Hilfe. DANKE!!!

Ich habe es - hoffentlich - so gemacht wie du geschrieben hast.

Hier ein kurzes Video:

atilla-22-03-2016

War das so gedacht?
Weil ich kann nur die 14 als AN Wert bestätigen, da alle anderen Zahlen im Bereich
D:I nicht mehr da sind.


LG
Angelina
Antworten Top
#55
Hallo Angelina,

da Du immer von löschen schriebst, sind sie nun weg.

Wenn sie bleiben sollen, muss im Code ein paar Zeilen ergänzt werden.

Bin aber gerade unterwegs, in ein zwei Stunden kann ich das Regeln.
Gruß Atilla
Antworten Top
#56
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
Huh 


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!

LG
Angelina
Antworten Top
#57
Hallo Angelina,

das Du nicht rot wirst, bei diesen Wünschen. Wink

Aber ich bin mal nicht so und hab noch etwas rot über.

Bisherige Codes löschen und folgenden in ein Modul:


Code:
Public Sub XLPHAN()
 Dim lngLetzteZeile As Long
 Dim lngSuchZeilenAnzahlMax As Long

 Dim rngSuchwert As Range

 Dim avntSuchwert() As Variant
 Dim iavntSuchwert1 As Long
 Dim iavntSuchwert2 As Long

 Dim rngDaten As Range

 Dim avntDaten() As Variant
 Dim iavntDaten1 As Long
 Dim iavntDaten2 As Long

 Dim vntSuchwert As Variant

 Dim avntErgebniswert() As Variant

 Dim blnFund As Boolean

 Dim rngFund As Range
 Dim rngDatenLastRow As Range

 With Sheets("Tabelle1")
     
     Intersect(.UsedRange, .Range("D:I")).Interior.ColorIndex = xlColorIndexNone
     Intersect(.UsedRange, .Range("O:Z")).Interior.Color = RGB(255, 204, 0)
     Intersect(.UsedRange, .Range("AA:AL")).ClearContents
   
     lngLetzteZeile = LetzteBeschriebeneZeile(.Range("D:AL"))
     If lngLetzteZeile = 0 Then Exit Sub
   
     lngSuchZeilenAnzahlMax = Val(.Range("AM1").Value)
     If lngSuchZeilenAnzahlMax = 0 Then Exit Sub
   
     Set rngDatenLastRow = Intersect(.Range("D:I"), .Rows(lngLetzteZeile))
     Set rngSuchwert = .Range("O1:Z" & lngLetzteZeile)
     avntSuchwert() = rngSuchwert.Value
           
     avntErgebniswert() = .Range("AA1:AL" & lngLetzteZeile).Value
   
     For iavntSuchwert1 = LBound(avntSuchwert, 1) To UBound(avntSuchwert, 1)
       
         Set rngDaten = .Range("D" & iavntSuchwert1).Resize(lngSuchZeilenAnzahlMax, 6)
     
         avntDaten() = rngDaten.Value
       
         For iavntSuchwert2 = LBound(avntSuchwert, 2) To UBound(avntSuchwert, 2)
           
             vntSuchwert = avntSuchwert(iavntSuchwert1, iavntSuchwert2)
           
             If Not IsEmpty(vntSuchwert) Then
           
                 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
                       
                         rngSuchwert.Cells(iavntSuchwert1, iavntSuchwert2).Interior.Color = vbYellow
                     Else
                       
                     End If
                 End If
               
             End If
         Next
       
         Set rngDaten = Nothing
       
     Next
   
     .Range("AA1:AL" & lngLetzteZeile).Value = avntErgebniswert()
 End With

 Erase avntDaten
 Erase avntErgebniswert
 Erase avntSuchwert

 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
 
 lngZd = LetzteBeschriebeneZeile(Range("D:AL"))
 varFeld_D_I = Range("D1:I" & lngZd)
 varFeld_O_AL = Range("O1:AL" & lngZd)
 strgAdress_D_I = Range("D1:I" & lngZd).Address
 strgAdress_O_Al = Range("O1:AL" & lngZd).Address


 Application.ScreenUpdating = False
 Columns("AN").ClearContents
 Range("A1:C" & lngZd).Interior.ColorIndex = xlColorIndexNone
 zählen2
 XLPHAN
 For pp = Application.Max(Columns("M")) To 1 Step -1
   lngZZ = Application.Match(pp, Range(Cells(1, 13), Cells(lngZd, 13)), 0)
   Range(Cells(lngZZ, 4), Cells(lngZd, 9)).ClearContents
   Range(Cells(lngZZ + 1, 15), Cells(lngZd, 38)).ClearContents
   
   XLPHAN
     
   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:
  • Angelina
Antworten Top
#58
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.

23  4 21
23  10  21
23  32  21
23  2 18
23  30  17
23  35  16
23  24  15
23  44  15
23  26  13
23  13  12
23  14  12

Anbei auch die Testdatei.


Angehängte Dateien
.xls   SuchZahlen-Schritt2-21-03-2016.xls (Größe: 150,5 KB / Downloads: 2)
.      \\\|///      Hoffe, geholfen zu haben.
       ( ô ô )      Grüße, André aus G in T  
  ooO-(_)-Ooo    (Excel 97-2019+365)
Antworten Top
#59
Hallo Angelina,

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
 
 lngZd = LetzteBeschriebeneZeile(Range("D:AL"))
 varFeld_D_I = Range("D1:I" & lngZd)
 varFeld_O_AL = Range("O1:AL" & lngZd)
 strgAdress_D_I = Range("D1:I" & lngZd).Address
 strgAdress_O_Al = Range("O1:AL" & lngZd).Address


 Application.ScreenUpdating = False
 Columns("AN").ClearContents
 Range("A1:C" & lngZd).Interior.ColorIndex = xlColorIndexNone
 zählen2
 XLPHAN
 For pp = Application.Max(Columns("M")) To 1 Step -1
   lngZZ = Application.Match(pp, Range(Cells(1, 13), Cells(lngZd, 13)), 0)
   Range(Cells(lngZZ, 4), Cells(lngZd, 9)).ClearContents
   Range(Cells(lngZZ + 1, 15), Cells(lngZd, 38)).ClearContents
   
   XLPHAN
     
   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:
  • Angelina
Antworten Top
#60
Hallöchen,

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)
Antworten Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste