Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1120to1124
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
VBA: Wiederholung von Zahlengruppen in Spalte
Zahlengruppen
Hallo,
ich quäle mich hier mit einem Problem herum, bei dem ich wahrscheinlich eine bessere VBA-Ausbildung
brauchen würde, um es selber lösen zu können. Ich glaube, die Lösung hängt irgendwie mit einem
Array zusammen:
Ich habe eine Spalte mit Zahlen zwischen 0 und 100 und es kommt immer wieder vor, daß mehrere Zahlen hintereinander in genau der Reihenfolge früher (weiter oben schon mal vorkamen). Ich möchte wissen, wann sich eine Gruppe wiederholt hat und in welcher Zeile das war. Hier ein Beispiel
53
30
29
51
25
27
58
86
25
16
66!
53!
89!
43!
37!
21!
44
5
9
16
9
53
41
80
33
80
91
10
27
76
66!
53!
89!
43!
37!
21! Gruppe von 6 Zahlen hat sich wiederholt. War schon in Zeile 12 bis 17 da.
8
6
98
100
65
18
21
Kann mir da bitte jemand helfen?
Die Datei:
https://www.herber.de/bbs/user/66246.xls
Danke,
Born

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: VBA: Wiederholung von Zahlengruppen in Spalte
28.11.2009 12:47:57
Zahlengruppen
Hallo,
ab welcher Anzahl? Also wie groß soll eine "Gruppe" mindestens sein? 2, 3, 4 ..... Zahlen?
Gruß
Nepumuk
AW: VBA: Wiederholung von Zahlengruppen in Spalte
28.11.2009 15:11:37
Zahlengruppen
Hallo Nepumuk,
gute Frage! Am besten wäre, ich könnte das für jede Anzahl aufrufen. Aber eine Gruppenlänge ab 4 aufeinander folgende Zahlen wäre sehr, sehr nützlich.
Born
AW: VBA: Wiederholung von Zahlengruppen in Spalte
29.11.2009 09:04:32
Zahlengruppen
Hallo,
kannst du mir sagen, wozu das ganze eigentlich gut sein soll? Woher kommen die Zahlen und was machst du mit der Information dass sich eine Gruppe wiederholt? Ich will da nämlich keine Zeit in irgendwelchen Unsinn investieren, denn so einfach ist die Sache nicht. Das Programm muss ja nicht nur nach Wiederholungen suchen, sondern sich auch merken, wo es schon welche gefunden hat. Wenn sich z.B. eine Fünfergruppe wiederholt, dann wiederholen sich natürlich auch die Zahlen 1-4 und 2-5 beim suchen nach Vierergruppen.
Gruß
Nepumuk
Anzeige
AW: VBA: Wiederholung von Zahlengruppen in Spalte
29.11.2009 09:04:37
Zahlengruppen
Hallo,
kannst ja mal testen ob es so funktioniert.
Sub test()
Dim ArBereich(), ArString(), ArAusgabe()
Dim AnzahlLaenge&, LCount&, A&, AA&
Dim CountTreffer&, temCounter&

On Error Resume Next
AnzahlLaenge = InputBox("Geben Sie die Suchlänge ein", , 6)
If AnzahlLaenge = 0 Then Exit Sub
On Error GoTo 0

ArBereich = Range("A2", Cells(Rows.Count, 1).End(xlUp))

Redim ArAusgabe(1 To Ubound(ArBereich), 1 To 2)

Redim Preserve ArString(Ubound(ArBereich))

For LCount = Lbound(ArBereich) To Ubound(ArBereich)
    For AA = 0 To AnzahlLaenge - 1
     If LCount + AA > Ubound(ArBereich) Then Exit For
     ArString(A) = ArString(A) & ArBereich(LCount + AA, 1)
    Next AA
    A = A + 1
Next LCount

Redim Preserve ArString(A - 1)

For A = Lbound(ArString) To Ubound(ArString)
 For AA = Lbound(ArString) To Ubound(ArString)
   If A <> AA Then
        If ArString(A) = ArString(AA) Then CountTreffer = CountTreffer + 1
        If CountTreffer > temCounter Then
         ArAusgabe((AA + 1), 1) = AnzahlLaenge
         ArAusgabe((AA + 1), 2) = (A + 2)
         temCounter = CountTreffer
        End If
   End If
 Next AA
Next A

Range("B2").Resize(Ubound(ArAusgabe), 2) = ArAusgabe

End Sub
Gruß Tino
Anzeige
Nochmal angepasst
29.11.2009 09:30:17
Tino
Hallo,
hat noch nicht richtig funktioniert, weil z. Bsp. aus 21 & 8 das gleiche wurde wie aus 2 & 18,
daher musste ich den String anders zusammenbauen.
Sub test()
Dim ArBereich(), ArString(), ArAusgabe()
Dim AnzahlLaenge&, LCount&, A&, AA&
Dim CountTreffer&, temCounter&

On Error Resume Next
AnzahlLaenge = InputBox("Geben Sie die Suchlänge ein", , 6)
If AnzahlLaenge = 0 Then Exit Sub
On Error GoTo 0

ArBereich = Range("A2", Cells(Rows.Count, 1).End(xlUp))

Redim ArAusgabe(1 To Ubound(ArBereich), 1 To 2)

Redim Preserve ArString(Ubound(ArBereich))

For LCount = Lbound(ArBereich) To Ubound(ArBereich)
    For AA = 0 To AnzahlLaenge - 1
     If LCount + AA > Ubound(ArBereich) Then Exit For
     ArString(A) = ArString(A) & ";" & ArBereich(LCount + AA, 1)
    Next AA
    A = A + 1
Next LCount

Redim Preserve ArString(A - 1)

For A = Lbound(ArString) To Ubound(ArString)
 For AA = Lbound(ArString) To Ubound(ArString)
   If A <> AA Then
        If ArString(A) = ArString(AA) Then CountTreffer = CountTreffer + 1
        If CountTreffer > temCounter Then
         ArAusgabe((AA + 1), 1) = AnzahlLaenge
         ArAusgabe((AA + 1), 2) = ArAusgabe((AA + 1), 2) & ";" & (A + 2)
         If Left$(ArAusgabe((AA + 1), 2), 1) = ";" Then _
         ArAusgabe((AA + 1), 2) = Right$(ArAusgabe((AA + 1), 2), Len(ArAusgabe((AA + 1), 2)) - 1)
         temCounter = CountTreffer
        End If
   End If
 Next AA
Next A

Range("B2").Resize(Ubound(ArAusgabe), 2) = ArAusgabe

End Sub
Gruß Tino
Anzeige
AW: Nochmal angepasst
29.11.2009 12:09:35
born2b@gmx.de
Hallo Tino,
vielen Dank. Das ist (fast) genau das, was ich gesucht habe. Ich habe es noch
an ein paar Stellen angepaßt und so läuft es. Im wesentlichen habe ich einiges
über Schleifen in Arrays lernen müssen.
Vielen Dank,
Born
schön wäre es gewesen...
29.11.2009 12:23:16
Tino
Hallo,
wenn Du mir oder uns den angepassten Code zeigen würdest
damit andere die diesen Beitrag lesen auch etwas davon haben.
Gruß Tino
AW: VBA: Wiederholung von Zahlengruppen in Spalte
29.11.2009 11:31:55
Zahlengruppen
Hallo Born,
mir ist jetzt nur die VBA-Lösung mit roher Gewalt eingefallen, die sich in geschachtelten Schleifen an das Ergebnis heranarbeitet. Da braucht es ggf. schon ein wenig Rechenzeit, wenn die Liste lang ist und die Spanne zwischen Min und Max-Wert der Gruppengöße groß. Bei Größe 4 bis 7 geht es noch recht flott.
Gruß
Franz
Sub GruppenSuchen()
Dim Zeile As Long, Zeilen As Long, StartZeile As Long, Spalte As Long, Ergebnis As Long
Dim LetzterTreffer As Long
Dim rngGrp As Range, GrpLaenge As Long, ZeileGrp As Long, ZeileVergleich As Long
Dim wks As Worksheet, bolIdentisch As Boolean, MinGrpLaenge As Long, MaxGrpLaenge As Long
Set wks = ActiveSheet
With wks
StartZeile = 3 'Zeile mit 1. Wert der Verglichen werden soll
Spalte = 1 'Spalte mit den zu vergleichenden Werten
Ergebnis = 2 'Spalte für Ergebnisausgabe der Gruppenlänge, Spalte daneben wird _
für vorherige Trefferzeile benutzt
'Anzahl Zeilen mit Daten in Spalte
Zeilen = .Cells(.Rows.Count, 1).End(xlUp).Row - StartZeile + 1
MinGrpLaenge = 4 'kleinste Gruppenlänge, die noch verglichen werden soll
MaxGrpLaenge = 7 'größte _
Gruppenlänge, die noch verglichen werden soll
'Altergebnisse löschen
.Range(.Cells(StartZeile, Ergebnis), .Cells(StartZeile + Zeilen - 1, _
Ergebnis + 1)).ClearContents
'Gruppenlänge in 1er-Schritten von maximale auf minimale Gruppenlänge reduzieren
For GrpLaenge = MaxGrpLaenge To MinGrpLaenge Step -1
'Gruppen der Länge in 1er-Schritten durch den Zellenblock verschieben und mit den _
restlichen Zeilen vergleichen
For Zeile = StartZeile To StartZeile + Zeilen - GrpLaenge
Set rngGrp = .Range(.Cells(Zeile, Spalte), _
.Cells(Zeile, Spalte).Offset(GrpLaenge - 1, 0))
LetzterTreffer = Zeile
If Zeile + 2 * GrpLaenge > StartZeile + Zeilen - 1 Then Exit For
'Blöcke bis zur letzten Zeile mit dem Gruppenblock vergleichen
For ZeileGrp = Zeile + GrpLaenge To StartZeile + Zeilen - GrpLaenge
bolIdentisch = True
'Prüfen, ob Zeile schon einem längeren Block als Treffer zugeordnet ist
If IsEmpty(.Cells(ZeileGrp, Ergebnis)) _
Or .Cells(ZeileGrp, Ergebnis) = GrpLaenge Then
'Zeilenweiser Vergleich der Blöcke
For ZeileVergleich = 1 To GrpLaenge
'Wertevergleich und Prüfung, ob Zeile schon Treffer eines längeren Block
If rngGrp.Cells(ZeileVergleich, 1)  .Cells(ZeileGrp + ZeileVergleich - 1, _
Spalte) _
Or Not (IsEmpty(.Cells(ZeileGrp + ZeileVergleich - 1, Ergebnis)) _
Or .Cells(ZeileGrp, Ergebnis) = GrpLaenge) Then
bolIdentisch = False
Exit For
End If
Next ZeileVergleich
If bolIdentisch = True Then
'Blocklänge in Ergebnisspalte eintragen
.Range(.Cells(ZeileGrp, Ergebnis), _
.Cells(ZeileGrp, Ergebnis).Offset(GrpLaenge - 1, 0)).Value _
= GrpLaenge
'vorherige Trefferzeile eintragen
.Cells(ZeileGrp, Ergebnis + 1).Offset(GrpLaenge - 1, 0) = LetzterTreffer
'vorherigen Trefferwert neu setzen
LetzterTreffer = ZeileGrp
'Zeilenzähler der Schleife anpassen
ZeileGrp = ZeileGrp + GrpLaenge - 1
End If
End If
Next ZeileGrp
Next Zeile
Next GrpLaenge
End With
End Sub

Anzeige

357 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige