Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema InputBox
BildScreenshot zu InputBox InputBox-Seite mit Beispielarbeitsmappe aufrufen

VBA: Wiederholung von Zahlengruppen in Spalte | Herbers Excel-Forum


Betrifft: VBA: Wiederholung von Zahlengruppen in Spalte von: born2b@gmx.de
Geschrieben am: 28.11.2009 12:45:09

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

  

Betrifft: AW: VBA: Wiederholung von Zahlengruppen in Spalte von: Nepumuk
Geschrieben am: 28.11.2009 12:47:57

Hallo,

ab welcher Anzahl? Also wie groß soll eine "Gruppe" mindestens sein? 2, 3, 4 ..... Zahlen?

Gruß
Nepumuk


  

Betrifft: AW: VBA: Wiederholung von Zahlengruppen in Spalte von: born2b@gmx.de
Geschrieben am: 28.11.2009 15:11:37

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


  

Betrifft: AW: VBA: Wiederholung von Zahlengruppen in Spalte von: Nepumuk
Geschrieben am: 29.11.2009 09:04:32

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


  

Betrifft: AW: VBA: Wiederholung von Zahlengruppen in Spalte von: Tino
Geschrieben am: 29.11.2009 09:04:37

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


  

Betrifft: Nochmal angepasst von: Tino
Geschrieben am: 29.11.2009 09:30:17

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


  

Betrifft: AW: Nochmal angepasst von: born2b@gmx.de
Geschrieben am: 29.11.2009 12:09:35

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


  

Betrifft: schön wäre es gewesen... von: Tino
Geschrieben am: 29.11.2009 12:23:16

Hallo,
wenn Du mir oder uns den angepassten Code zeigen würdest
damit andere die diesen Beitrag lesen auch etwas davon haben.


Gruß Tino


  

Betrifft: AW: VBA: Wiederholung von Zahlengruppen in Spalte von: fcs
Geschrieben am: 29.11.2009 11:31:55

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



Beiträge aus den Excel-Beispielen zum Thema "VBA: Wiederholung von Zahlengruppen in Spalte"