Anzahl von Reihenfolgen feststellen

Hallo,
ich suche eine Möglichkeit, eine Meldung bei wiederkehrenden Elementen zu generieren, und es wäre super nett, wenn mir jemand dabei einen heißen Tip geben könnte, wie das Makro dazu aussieht.
Meine Tabellenspalten sehen ungefähr so aus:
x
x
x
x
x
x
x
x
x
x
x
x
x
x
x
x
x
x
Die x sind keine Platzhalter, sondern stehen tatsächlich so in einer Spalte der Tabelle.
Ziel ist, eine Meldung zu generieren, wenn z.B. in einer Spalte 4x hintereinander ein x einzeln steht, dh von einer leeren Zelle gefolgt wird.
z.B. so:
x
(leer)
x
(leer)
x
(leer)
x
(leer)
Ebenso soll eine Meldung generiert werden, wenn z.B. 3x hintereinander 2 oder mehr X aufeinanderfolgen, ohne dass ein einzelnes X dazwischen steht. Z.B. so:
X
X
X
(leer)
X
X
(leer)
X
X
X
(leer)
Frage: geht das?
Ihr würdet mir super helfen, mit einem Tip oder einem kleinen Progrämmchen. Viele Dank!!!
Herzliche Grüße
Marion

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Sub serien() Dim arr() As Integer, zz As Long, stat As Byte, ii As Long ReDim arr(1 To Cells(Rows.Count, 1).End(xlUp).Row + 1) For zz = 1 To Cells(Rows.Count, 1).End(xlUp).Row + 1 Select Case LCase(Cells(zz, 1)) Case "x" If stat = 1 Then arr(ii) = arr(ii) + 1 Else stat = 1: ii = ii + 1: arr(ii) = 1 End If Case "": stat = 0: ii = ii + 1 Case Else: stat = 0: ii = ii + 1: arr(ii) = -1 End Select If ii > 5 Then If arr(ii - 5) > 1 And arr(ii - 4) = 0 And _ arr(ii - 3) > 1 And arr(ii - 2) = 0 And _ arr(ii - 1) > 1 And arr(ii - 0) = 0 Then Cells(zz, 3) = "3 x mehr als 1" End If If ii > 7 Then If arr(ii - 7) & arr(ii - 6) & arr(ii - 5) & arr(ii - 4) _ & arr(ii - 3) & arr(ii - 2) & arr(ii - 1) & arr(ii) = "10101010" Then _ Cells(zz, 3) = "4 x 1" End If End If Next zz End Sub

Hallo Marion,
Gegenfrage:
Was meinst du mit "funktioniert das auch, wenn ..."?
Wenn du damit meinst, dass die vorgestellte Formel bzw. das Makro auch dann einen Hinweis ausgeben,
kannst du das doch einfach ausprobieren.
Wenn du aber meinst, dass (mit anderer Formel/anderem Makro) auch bei anderen Konstellationen
Hinweise ausgeben werden sollen, müsstest du diese Konstellationen genau beschreiben.
Eine Möglichkeit der Beschreibung einiger Beispielmuster:

x ist eine Zelle = x
L ist eine leere Zelle
U ist eine Zelle<>x
(mx) steht für mindestens zwei aufeinanerfolgende x
(pL) steht für eine oder mehrere aufeinanderfolgende leere Zellen
-----------Muster---------- Hinweis
...UxLxLxLxL...             4 x L
...Ux(pL)x(pL)x(pL)xL...    4 x LL
...(mx)L(mx)L(mx)L...       3 xx L
...(mx)(pL)(mx)(pL)(mx)L... 3 xx LL
und die Umsetzung per Makro:
Option Explicit
Sub serien2()
Dim arr() As String, zz As Long, stat As Byte, ii As Long, strT As String
ReDim arr(1 To Cells(Rows.Count, 1).End(xlUp).Row + 1)
Columns(4).ClearContents
stat = 99
For zz = 1 To Cells(Rows.Count, 1).End(xlUp).Row + 1
Select Case LCase(Cells(zz, 1))
Case "x"
If stat = 1 Then
If arr(ii) = "x" Then arr(ii) = "xx"
Else
stat = 1: ii = ii + 1: arr(ii) = "x"
End If
Case ""
If stat = 0 Then
If arr(ii) = "L" Then arr(ii) = "LL"
Else
stat = 0: ii = ii + 1: arr(ii) = "L"
End If
Case Else
If stat <> 2 Then stat = 2: ii = ii + 1: arr(ii) = "a"
End Select
If ii > 5 Then
strT = arr(ii - 5) & arr(ii - 4) _
& arr(ii - 3) & arr(ii - 2) & arr(ii - 1) & arr(ii)
If strT = "xxLxxLxxL" Then
Cells(zz, 4) = "3 xx L"
ElseIf Replace(strT, "LL", "L") = "xxLxxLxxL" Then
Cells(zz, 4) = "3 xx LL"
End If
If ii > 7 Then
strT = arr(ii - 7) & arr(ii - 6) & strT
If strT = "xLxLxLxL" Then
Cells(zz, 4) = "4 x L"
ElseIf Replace(strT, "LL", "L") = "xLxLxLxL" Then
Cells(zz, 4) = "4 x LL"
End If
End If
End If
Next zz
End Sub

Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort

Beliebteste Forumthreads (12 Monate)

Anzahl von Reihenfolgen feststellen

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread