Clever-Excel-Forum

Normale Version: Serie herausfinden
Du siehst gerade eine vereinfachte Darstellung unserer Inhalte. Normale Ansicht mit richtiger Formatierung.
Hallo Leute :)

ich bin langsam am verzweifeln... Ich versuche von Excel automatisiert Serien erkennen zu lassen... Habe das Ganze jetzt mal händisch gemacht, aber würde das gerne für viele weitere 10000ende von Zeilen machen :D

Hier mal zur Verdeutlichung:

[attachment=10411]



Die Serien der 0en bzw 1en soll gezählt werden. Es bezieht sich also auf Spalte J, ich will wissen wie oft hintereinander eine 1 oder eine 0 gestanden hat.

Falls mir da jemand helfen kann, wäre ich ihm zu sehr dankbar :*
Hi,

hier mal ein Vorschlag mit einer Hilfsspalte, die du einfach ausblendest:

Tabelle4

ABC
1111
2023
302
402
5131
6043
704
804
9152
1015
11062
1206
13173
1417
1517
Formeln der Tabelle
ZelleFormel
C1=ZÄHLENWENN($B$1:$B$15;B1)
B2=WENN(A1=A2;B1;B1+1)
C2=WENN(B2<>B1;ZÄHLENWENN($B$1:$B$15;B2);"")

Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4.8
(26.03.2017, 20:07)WillWissen schrieb: [ -> ]Hi,

hier mal ein Vorschlag mit einer Hilfsspalte, die du einfach ausblendest:

Tabelle4

ABC
1111
2023
302
402
5131
6043
704
804
9152
1015
11062
1206
13173
1417
1517
Formeln der Tabelle
ZelleFormel
C1=ZÄHLENWENN($B$1:$B$15;B1)
B2=WENN(A1=A2;B1;B1+1)
C2=WENN(B2<>B1;ZÄHLENWENN($B$1:$B$15;B2);"")

Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4.8


gar keine so schlechte idee Blush  werde ich morgen mal ausprobieren. vielen dank :)   
80.000 ZÄHLENWENN x 40.000 Auswertungszellen = 3,2 Mrd Rechenvorgänge! => Probiere es besser nicht aus!

A2: Deine Daten 0 und 1
B2: =(A1=A2)*B1+1
C2: =B2*(B2>=B3) mit Format 0;;

Die Anzahlen der jew. Gruppe stehen beim letzten Auftreten, nicht beim ersten.
Hallo zusammen,

bei so vielen Daten, könnte man auch VBA einsetzen.

Zum Beispiel würde der folgende Code die Serien beim ersten Auftreten listen:


Code:
Sub serien()

 Dim i As Long, j As Long
 Dim lngZ As Long

 Dim arr As Variant
 Dim varK
 Dim D1 As Object
 Set D1 = CreateObject("Scripting.Dictionary")

 Application.ScreenUpdating = False
 With Worksheets("Tabelle1")
   lngZ = .Cells(.Rows.Count, 1).End(xlUp).Row
   arr = .Range("A1:A" & lngZ)
   
   For i = 2 To UBound(arr)
     If arr(i, 1) <> arr(i - 1, 1) Then
       D1(j + 1) = D1(j + 1) + 1
       j = j + 1
     Else
        D1(j) = D1(j) + 1
     End If
   Next i
   
   .Range("B2:B" & lngZ).ClearContents
   arr = .Range("B1:B" & lngZ)
   j = 1
   For Each varK In D1.keys
     arr(j, 1) = D1(varK)
     j = D1(varK) + j
   Next
   .Range("B2:B2").Resize(j) = arr
 End With
 Application.ScreenUpdating = True

End Sub


Und folgender beim letzten Auftreten:


Code:
Sub serien()

 Dim i As Long, j As Long
 Dim lngZ As Long

 Dim arr As Variant
 Dim varK
 Dim D1 As Object
 Set D1 = CreateObject("Scripting.Dictionary")

 Application.ScreenUpdating = False
 With Worksheets("Tabelle1")
   lngZ = .Cells(.Rows.Count, 1).End(xlUp).Row
   arr = .Range("A1:A" & lngZ)
   
   For i = 2 To UBound(arr)
     If arr(i, 1) <> arr(i - 1, 1) Then
       D1(j + 1) = D1(j + 1) + 1
       j = j + 1
     Else
        D1(j) = D1(j) + 1
     End If
   Next i
   
   .Range("B1:B" & lngZ).ClearContents
   arr = .Range("B1:B" & lngZ)
   j = 1
   For Each varK In D1.keys
   j = D1(varK) + j
     arr(j, 1) = D1(varK)
     
   Next
   .Range("B1:B2").Resize(j) = arr
 End With
 Application.ScreenUpdating = True

End Sub
Hallo atilla,

man muss das mit dem Scripting.Dictionary auch nicht übertreiben.

In diesem Fall, in dem die Position der Ausgabe bekannt ist, verdoppelt die Nutzung des Scripting.Dictionaries die Rechenzeit.
(Auf meinem Rechner bei 100.000 Zeilen von 0,17 auf 0,37 Sekunden Blush ).

Hier ohne Scripting.Dictionary


Code:
Private Sub serien()

 Dim i As Long, j As Long
 Dim dblStart As Double
 Dim lngZ As Long

 Dim arr As Variant
 Dim arrz As Variant
 Dim varK

 Application.ScreenUpdating = False
 dblStart = Timer
 With Worksheets("Tabelle1")
   lngZ = .Cells(.Rows.Count, 1).End(xlUp).Row
   arr = .Range("A1:A" & lngZ)
   .Range("B1:B" & lngZ).ClearContents
   arrz = .Range("B1:B" & lngZ)
   j = 1
   arrz(j, 1) = 1
   For i = 2 To UBound(arr)
     If arr(i, 1) <> arr(i - 1, 1) Then
        j = i
        arrz(j, 1) = 1
     Else
        arrz(j, 1) = arrz(j, 1) + 1
     End If
   Next i   
   .Range("B1:B" & lngZ) = arrz
 End With
 MsgBox Timer - dblStart
 Application.ScreenUpdating = True
End Sub
ps (Bei 1.000.000 Zeilen von 1,6 auf 17 Sekunden Blush )
Gutem Morgen Helmut,

schöne Lösung.
Es sieht so aus, als ob Du um die Zeit ausgeschlafener bist als ich.

Aber das mit Bereiche leer in ein Array einlesen und wieder zurückschreiben ist schon eine tolle Sache, oder?
vielen dank für die antworten :)

ja sind einige daten ;;) aber in der regel werden nie mehr als 5000 auf einmal bearbeitet.
Hi,

da würde ich das mit Formeln machen:

Arbeitsblatt mit dem Namen 'Tabelle1'
 ABC
2012
3101
4122
5031
6103
7141
8051
9101
10102
11161

ZelleFormel
B2=(A3<>A2)*(MAX(B$1:B1)+1)
C2=WENNFEHLER(VERGLEICH(ZEILE(A2);B:B;0);ANZAHL(A:A))-VERGLEICH(ZEILE(A1);B:B;0)
Diese Tabelle wurde mit Tab2Html (v2.4.1) erstellt. ©Gerd alias Bamberg