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 | A | B | C |
1 | 1 | 1 | 1 |
2 | 0 | 2 | 3 |
3 | 0 | 2 | |
4 | 0 | 2 | |
5 | 1 | 3 | 1 |
6 | 0 | 4 | 3 |
7 | 0 | 4 | |
8 | 0 | 4 | |
9 | 1 | 5 | 2 |
10 | 1 | 5 | |
11 | 0 | 6 | 2 |
12 | 0 | 6 | |
13 | 1 | 7 | 3 |
14 | 1 | 7 | |
15 | 1 | 7 | |
Formeln der Tabelle |
Zelle | Formel | 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
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
).
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
)
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' |
| A | B | C |
2 | 0 | 1 | 2 |
3 | 1 | 0 | 1 |
4 | 1 | 2 | 2 |
5 | 0 | 3 | 1 |
6 | 1 | 0 | 3 |
7 | 1 | 4 | 1 |
8 | 0 | 5 | 1 |
9 | 1 | 0 | 1 |
10 | 1 | 0 | 2 |
11 | 1 | 6 | 1 |
Zelle | Formel |
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 |