Hallo Angelina,
mann, mann, mann.....
Du hast auch mal besser Erklärt, aber ich muss gestehn, es nicht einfach zu erklären.
Andre, ich habe jetzt verstanden, wie gezählt wird.
Und es ist gar nicht so kompliziert, wie wir uns das gedacht haben. :26:
Wenn wir ein paar Ausdrücke festlegen, dann kann man das besser veranschaulichen.
-
Blockanzahl soll der Wert in AM1 sein
-
Suchfeld sollen die Spalte D:I sein.
-
Dreierzeile sollen die Zeilen sein, bei denen im
Suchfeld in einer Zeile drei Zellen farbigen Hintergrund haben.
-
Anfangszeile soll die Zeile in D:I sein, in der gerade in O:Z eine Zelle betrachtet wird
-
Endzeile soll die Zeile in D:I sein,
welche eine Zeile vor der
Dreierzeile ist!!!!!
Es werden alle Zellen in O:Z betrachtet und es gilt:
1. wenn nicht leer und nicht grau oder gelb, dann wird gezählt.
2. wenn gelb, dann wird im
Suchfeld von der
Anfangszeile bis zur
Endzeile geschaut, ob die Zahl dort enthalten, wenn nicht, dann wird gezählt.
3. wenn grau, dann braucht nicht von der
Anfangszeile bis zur
Endzeile gesucht werden!
Hier kommt jetzt der Wert aus AM1 die
Blockanzahl ins Spiel.
Man betrachtet im
Suchfeld nur die Zeilen von
Endzeile -(
Blockanzahl-1) bis
Endzeile
Beispiel: Zeile 23 ist eine Dreierzeile. In AM1 steht 5. Dann braucht man nur die Zeilen 19:22 betrachten.
Also solange wir nicht in Zeile 19 angelangt sind, brauchen die grauen Zellen nicht untersucht werden. Ab Zeile 19 geht es wie für Gelb.
Mit anderen Worten grau bedeutet, dass der betrachtete Wert in den nächsten 5 (
Blockanzahl) Zeilen ab der betrachteten Zeile auf jeden Fall auftauchen wird.
4. Für die
Dreierzeile gilt: alle Zahlen in O:Z in der
Dreierzeile werden grundsätzlich gezählt.
5. Alle Zählungen natürlich ohne doppelte.
Nach diesen Erkenntnissen, kann der Code natürlich wesentlich einfacher aufgebaut werden und vor allem arbeitet der dann auch wesentlich schneller.
So Angelina, nun bist Du wieder an der Reihe.
Unten den Code (den gesamten Code!) in ein Modul kopieren und nur zählen1() ausführen. Dann bitte unbedingt berichten, dass alles richtig ist, und das der Code keinen Wimpernschlag braucht!!!!! :@
Code:
Option Explicit
Public arr()
Sub zählen1()
Dim i As Long, j As Long, pp As Long
Dim strgSammlung As String
Application.ScreenUpdating = False
Columns("AN").ClearContents
zählen2
If IsEmpty(arr(0)) Then Exit Sub
For pp = 0 To Application.Max(Columns("M")) - 1
For i = 1 To arr(pp)
For j = 15 To 26
If Cells(i, j) <> "" Then
If Cells(i, j).Interior.ColorIndex = 6 Then
If Application.CountIf(Range(Cells(i, 4), Cells(arr(pp), 9)), Cells(i, j)) = 0 Then
If InStr(1, strgSammlung, Format(Cells(i, j), "00"), vbTextCompare) = 0 Then strgSammlung = strgSammlung & "#" & Format(Cells(i, j), "00")
End If
ElseIf Cells(i, j).Interior.ColorIndex = 15 Then
If i >= arr(pp) + 2 - Cells(1, 39) Then
If Application.CountIf(Range(Cells(i, 4), Cells(arr(pp), 9)), Cells(i, j)) = 0 Then
If InStr(1, strgSammlung, Format(Cells(i, j), "00"), vbTextCompare) = 0 Then strgSammlung = strgSammlung & "#" & Format(Cells(i, j), "00")
End If
End If
Else
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
For j = 15 To 26
If Cells(i, j) <> "" Then
If InStr(1, strgSammlung, Format(Cells(i, j), "00"), vbTextCompare) = 0 Then strgSammlung = strgSammlung & "#" & Format(Cells(i, j), "00")
End If
Next j
If UBound(Split(strgSammlung, "#")) > 0 Then
Cells(arr(pp) + 1, 40) = UBound(Split(strgSammlung, "#"))
Cells(arr(pp) + 1, 14) = Replace(Join(Split(strgSammlung, "#"), ", "), ", ", "", 1, 1)
Else
Cells(arr(pp) + 1, 40) = 0
End If
strgSammlung = ""
Next pp
Erase arr
Application.ScreenUpdating = True
End Sub
Sub zählen2()
Dim lngLetzteZeile As Long
Dim i As Long, j As Long, k As Long, p As Long
Columns("M:N").ClearContents
lngLetzteZeile = LetzteBeschriebeneZeile(Range("D:I"))
ReDim arr(0 To 0)
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
ReDim Preserve arr(0 To p)
arr(p) = i - 1
p = p + 1
Cells(i, 41) = k
Cells(i, 13) = Application.Max(Columns("M")) + 1
Range(Cells(i, 1), Cells(i, 3)).Interior.ColorIndex = 3
Else
Cells(i, 41) = k
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
Oder gilt die 5 etwa doch für alle? Ich hab da noch keine allgemeingültige Regel erkannt, vermute aber inzwischen, dass die 5 bei allen Zahlen zu berücksichtigen ist. Entsprechend müssten bei diesem Eintrag die Bereiche ab der Zeile geprüft werden, in der die Zahl steht. Ob da nun eine 5, 1 oder 99 steht, wäre unerheblich. Erheblich ist, dass da was steht.