PDA

Vollständige Version anzeigen : Benötige Hilfe für Unfallstatistik


saegio
27.03.2012, 20:39
Hallo, ich benötige etwas Hilfe mit meiner Unfallstatistik. Ich habe eine Tabelle der Form:

Event ID | Unfallkategorie
1............|.......Kat1
2............|.......Kat5, Kat1
3............|.......Kat3
4............|.......Kat1, Kat10
...... .......|..............
n............|.......Kat2

In dieser Tabeller werden also bestimmten Events eine bestimmte Unfallkategorie zugeordnet, wie z. B. "abnormal runway contact".

Außerdem gibt es eine 2te Tabelle der Form:

............... Event ID|1 | 2 | 3 | 4 | 5 |...| n
Ursache(1)..............x.............................
Ursache(2)...................x.............x.........
Ursache(3)...................x........................
... ...................................x.........x.........
Ursache(m)...........................x...............

In dieser Tablle wird also jedem Event eine oder mehrere Ursachen zugeordnet. Was ich jetzt brauche ist eine Möglichkeit die Anzahl der jeweiligen Ursachen für eine bestimmte Unfallkategorie zu bestimmen. Also z.B. wie oft ist Ursache (3) der Grund für einen Unfall der Kategorie Kat10? Die Verknüpfung erfolgt dabei über die Event ID.

Ich hoffe ich habe es verständlich geschildert und jemand kann mir helfen :)

Erich G.
29.03.2012, 19:13
Hi,
deine Frage ist schon ein kleines bisschen älter, aber vielleicht suchst du ja noch nach einer Umsetzung.
Hattest du an eine Formel- oder eine VBA-Lösung gedacht?

Hier mal per VBA:;) Option Explicit

Sub Auswert()
Dim arEK, arUE, zz As Long, arK, cc As Long, arZ
Dim arUK(), ii As Long, oDic As Object

' Die beiden Quellen können - wie auch die Ergebnisausgabe -
' auf verschiedenen Blättern sein. (Hier ist alles auf einem Blatt.)
arEK = Sheets("Tabelle2").Cells(4, 1).CurrentRegion ' ab Zelle A4: Events/Kateg.
arUE = Sheets("Tabelle2").Cells(1, 5).CurrentRegion ' ab Zelle E1: Ursachen/Events

If UBound(arEK) <> UBound(arUE, 2) Then
MsgBox "Anzahl Events muss bei Kateg. und Ursachen übereinstimmen", _
vbCritical, "Abbruch"
Exit Sub
End If
Set oDic = CreateObject("Scripting.Dictionary")
For zz = 2 To UBound(arEK)
arK = Split(arEK(zz, 2), ",")
For cc = 0 To UBound(arK)
If oDic.Exists(arK(cc)) Then
arZ = oDic(arK(cc))
arZ(zz - 1) = arZ(zz - 1) + 1
oDic(arK(cc)) = arZ
Else
ReDim arZ(1 To UBound(arEK) - 1)
arZ(zz - 1) = 1
oDic.Add arK(cc), arZ
End If
Next cc
Next zz
arK = oDic.Keys
arZ = oDic.items
ReDim arUK(0 To UBound(arUE) - 1, 0 To oDic.Count)
For cc = 1 To UBound(arUK, 2)
arUK(0, cc) = arK(cc - 1)
Next cc
For zz = 1 To UBound(arUE) - 1
arUK(zz, 0) = arUE(zz + 1, 1)
For cc = 1 To UBound(arUE, 2) - 1
If Not IsEmpty(arUE(zz + 1, cc + 1)) Then
For ii = 0 To UBound(arZ)
If arZ(ii)(cc) = 1 Then arUK(zz, ii + 1) = arUK(zz, ii + 1) + 1
Next ii
End If
Next cc
Next zz
' Ausgabe ab Zelle M2
Sheets("Tabelle2").Cells(2, 13).Resize(UBound(arUK) + 1, UBound(arUK, 2) + 1) = arUK
Exit Sub

' ab hier Testausgabe (ab Zelle M21)
ArrOut Cells(22, 13), 12, arK
For ii = LBound(arZ) + 1 To UBound(arZ) + 1
Cells(21, 13 + ii) = arEK(ii + 1, 1)
Next ii
For zz = LBound(arZ) To UBound(arZ)
For ii = LBound(arZ(zz)) To UBound(arZ(zz))
Cells(zz + 22, 13 + ii) = arZ(zz)(ii)
Next ii
Next zz
End Sub

Sub ArrOut(rng As Range, intD As Integer, arr) ' nur für Testausgabe
If Not IsArray(arr) Then
MsgBox "ArrOut - kein Array"
Else
Select Case intD
Case 0: MsgBox "ArrOut - intD=0"
Case 1: rng(1).Resize(UBound(arr) - LBound(arr) + 1) = arr
Case 2: rng(1).Resize(UBound(arr) - LBound(arr) + 1, _
UBound(arr, 2) - LBound(arr, 2) + 1) = arr
Case 11: rng(1).Resize(, UBound(arr) - LBound(arr) + 1) = arr
Case 12: rng(1).Resize(UBound(arr) - LBound(arr) + 1) = Application.Transpose(arr)
Case Else: MsgBox "ArrOut - intD falsch"
End Select
End If
End SubUnd hier eine Mappe zum Testen:

saegio
30.03.2012, 04:49
VBA wäre schon sinnvoll denke ich. Leider übersteigt das im MOment meine Kenntnisse.

Danke für deinen Upload. Ich schau mir das mal an, aber erstmal bissel schlafen :)

Thomas Ramel
30.03.2012, 05:39
Grüezi saegio

Wenn du deine Datenerfassung umschreibst und pro Zeile nur eine einzelne Ursache erfasst, kannst Du die Auswertung dann sehr einfach und flexibel mit einer Pivot-Tabelle machen:

<table border='1' cellspacing='0' cellpadding='2' valign='middle' colspan='12' style='font-family:Calibri; color:#000000; background-color:#FFFFFF; font-size:11px; font-weight:bold; font-style:normal; '><colgroup><col width='28pt'><col width='60pt'><col width='79.5pt'><col width='60pt'><col width='132.75pt'><col width='124.5pt'><col width='10.5pt'><col width='10.5pt'><col width='10.5pt'><col width='11.25pt'><col width='81.75pt'><col width='60pt'></colgroup><tr style='background-color:#FAFAFA'><td align='middle' colspan='12'>Arbeitsblatt mit dem Namen 'Tabelle2'</td></tr><tr style='background-color:#cacaca'><td>*</td><td align='middle'>A</td><td align='middle'>B</td><td align='middle'>C</td><td align='middle'>D</td><td align='middle'>E</td><td align='middle'>F</td><td align='middle'>G</td><td align='middle'>H</td><td align='middle'>I</td><td align='middle'>J</td><td align='middle'>K</td></tr><tr><td style='background-color:#cacaca' align='middle'>1</td><td align='left' style='font-family:Arial; ' >Event ID</td><td align='left' >Unfallkategorie</td><td align='right' style='font-weight:normal; ' >*</td><td align='right' style='font-weight:normal; ' >*</td><td align='right' style='font-weight:normal; ' >*</td><td align='right' style='font-weight:normal; ' >*</td><td align='right' style='font-weight:normal; ' >*</td><td align='right' style='font-weight:normal; ' >*</td><td align='right' style='font-weight:normal; ' >*</td><td align='right' style='font-weight:normal; ' >*</td><td align='right' style='font-weight:normal; ' >*</td></tr><tr><td style='background-color:#cacaca' align='middle'>2</td><td align='right' style='font-family:Arial; font-weight:normal; ' >1</td><td align='left' style='font-weight:normal; ' >Kat1</td><td align='right' style='font-weight:normal; ' >*</td><td align='right' style='font-weight:normal; ' >*</td><td align='right' style='font-weight:normal; ' >*</td><td align='right' style='font-weight:normal; ' >*</td><td align='right' style='font-weight:normal; ' >*</td><td align='right' style='font-weight:normal; ' >*</td><td align='right' style='font-weight:normal; ' >*</td><td align='right' style='font-weight:normal; ' >*</td><td align='right' style='font-weight:normal; ' >*</td></tr><tr><td style='background-color:#cacaca' align='middle'>3</td><td align='right' style='font-family:Arial; font-weight:normal; ' >2</td><td align='left' style='font-weight:normal; ' >Kat5</td><td align='right' style='font-weight:normal; ' >*</td><td align='left' style='background-color:#B8CCE4; font-weight:normal; ' >Anzahl von Unfallkategorie</td><td align='left' style='background-color:#B8CCE4; font-weight:normal; ' >Spaltenbeschriftungen</td><td align='right' style='background-color:#B8CCE4; font-weight:normal; ' >*</td><td align='right' style='background-color:#B8CCE4; font-weight:normal; ' >*</td><td align='right' style='background-color:#B8CCE4; font-weight:normal; ' >*</td><td align='right' style='background-color:#B8CCE4; font-weight:normal; ' >*</td><td align='right' style='background-color:#B8CCE4; font-weight:normal; ' >*</td><td align='right' style='font-weight:normal; ' >*</td></tr><tr><td style='background-color:#cacaca' align='middle'>4</td><td align='right' style='font-family:Arial; font-weight:normal; ' >2</td><td align='left' style='font-weight:normal; ' >Kat1</td><td align='right' style='font-weight:normal; ' >*</td><td align='left' style='background-color:#B8CCE4; font-weight:normal; ' >Zeilenbeschriftungen</td><td align='right' style='background-color:#B8CCE4; font-weight:normal; ' >1</td><td align='right' style='background-color:#B8CCE4; font-weight:normal; ' >2</td><td align='right' style='background-color:#B8CCE4; font-weight:normal; ' >3</td><td align='right' style='background-color:#B8CCE4; font-weight:normal; ' >4</td><td align='left' style='background-color:#B8CCE4; font-weight:normal; ' >n</td><td align='left' style='background-color:#B8CCE4; font-weight:normal; ' >Gesamtergebnis</td><td align='right' style='font-weight:normal; ' >*</td></tr><tr><td style='background-color:#cacaca' align='middle'>5</td><td align='right' style='font-family:Arial; font-weight:normal; ' >3</td><td align='left' style='font-weight:normal; ' >Kat3</td><td align='right' style='font-weight:normal; ' >*</td><td align='left' style='font-weight:normal; ' >Kat1</td><td align='right' style='font-weight:normal; ' >1</td><td align='right' style='font-weight:normal; ' >1</td><td align='right' style='font-weight:normal; ' >*</td><td align='right' style='font-weight:normal; ' >1</td><td align='right' style='font-weight:normal; ' >*</td><td align='right' style='font-weight:normal; ' >3</td><td align='right' style='font-weight:normal; ' >*</td></tr><tr><td style='background-color:#cacaca' align='middle'>6</td><td align='right' style='font-family:Arial; font-weight:normal; ' >4</td><td align='left' style='font-weight:normal; ' >Kat1</td><td align='right' style='font-weight:normal; ' >*</td><td align='left' style='font-weight:normal; ' >Kat10</td><td align='right' style='font-weight:normal; ' >*</td><td align='right' style='font-weight:normal; ' >*</td><td align='right' style='font-weight:normal; ' >*</td><td align='right' style='font-weight:normal; ' >1</td><td align='right' style='font-weight:normal; ' >*</td><td align='right' style='font-weight:normal; ' >1</td><td align='right' style='font-weight:normal; ' >*</td></tr><tr><td style='background-color:#cacaca' align='middle'>7</td><td align='right' style='font-family:Arial; font-weight:normal; ' >4</td><td align='left' style='font-weight:normal; ' >Kat10</td><td align='right' style='font-weight:normal; ' >*</td><td align='left' style='font-weight:normal; ' >Kat2</td><td align='right' style='font-weight:normal; ' >*</td><td align='right' style='font-weight:normal; ' >*</td><td align='right' style='font-weight:normal; ' >*</td><td align='right' style='font-weight:normal; ' >*</td><td align='right' style='font-weight:normal; ' >1</td><td align='right' style='font-weight:normal; ' >1</td><td align='right' style='font-weight:normal; ' >*</td></tr><tr><td style='background-color:#cacaca' align='middle'>8</td><td align='left' style='font-family:Arial; font-weight:normal; ' >n</td><td align='left' style='font-weight:normal; ' >Kat2</td><td align='right' style='font-weight:normal; ' >*</td><td align='left' style='font-weight:normal; ' >Kat3</td><td align='right' style='font-weight:normal; ' >*</td><td align='right' style='font-weight:normal; ' >*</td><td align='right' style='font-weight:normal; ' >1</td><td align='right' style='font-weight:normal; ' >*</td><td align='right' style='font-weight:normal; ' >*</td><td align='right' style='font-weight:normal; ' >1</td><td align='right' style='font-weight:normal; ' >*</td></tr><tr><td style='background-color:#cacaca' align='middle'>9</td><td align='right' style='font-weight:normal; ' >*</td><td align='right' style='font-weight:normal; ' >*</td><td align='right' style='font-weight:normal; ' >*</td><td align='left' style='font-weight:normal; ' >Kat5</td><td align='right' style='font-weight:normal; ' >*</td><td align='right' style='font-weight:normal; ' >1</td><td align='right' style='font-weight:normal; ' >*</td><td align='right' style='font-weight:normal; ' >*</td><td align='right' style='font-weight:normal; ' >*</td><td align='right' style='font-weight:normal; ' >1</td><td align='right' style='font-weight:normal; ' >*</td></tr><tr><td style='background-color:#cacaca' align='middle'>10</td><td align='right' style='font-weight:normal; ' >*</td><td align='right' style='font-weight:normal; ' >*</td><td align='right' style='font-weight:normal; ' >*</td><td align='left' style='background-color:#B8CCE4; font-weight:normal; ' >Gesamtergebnis</td><td align='right' style='background-color:#B8CCE4; font-weight:normal; ' >1</td><td align='right' style='background-color:#B8CCE4; font-weight:normal; ' >2</td><td align='right' style='background-color:#B8CCE4; font-weight:normal; ' >1</td><td align='right' style='background-color:#B8CCE4; font-weight:normal; ' >2</td><td align='right' style='background-color:#B8CCE4; font-weight:normal; ' >1</td><td align='right' style='background-color:#B8CCE4; font-weight:normal; ' >7</td><td align='right' style='font-weight:normal; ' >*</td></tr><tr><td style='background-color:#cacaca' align='middle'>11</td><td align='right' style='font-weight:normal; ' >*</td><td align='right' style='font-weight:normal; ' >*</td><td align='right' style='font-weight:normal; ' >*</td><td align='right' style='font-weight:normal; ' >*</td><td align='right' style='font-weight:normal; ' >*</td><td align='right' style='font-weight:normal; ' >*</td><td align='right' style='font-weight:normal; ' >*</td><td align='right' style='font-weight:normal; ' >*</td><td align='right' style='font-weight:normal; ' >*</td><td align='right' style='font-weight:normal; ' >*</td><td align='right' style='font-weight:normal; ' >*</td></tr></table><table style='font-family:Arial; font-size:7pt'><tr><td style='color:#333333'>Diese Tabelle wurde mit Tab2Html (v2.4.1) erstellt. ©Gerd alias Bamberg</td></tr></table>

Erich G.
30.03.2012, 07:22
Hi Thomas,
dein Vorschlag (andere Erfasssung, Pivot-Auswertung) kann sicher die Beschreibung der vorgegebenen
Relation Event : Kategorie (1,n : 1,m) erleichtern. Das wäre auch mit einer Formel noch ganz gut machbar.

Daneben ist vorgegeben die Relation Ursache : Event (0,n : 0,m)

Aufgabe ist nun wohl, die Relation Ursache : Kategorie zu ermitteln.
Das geht IMHO nicht mehr so einfach mit Formeln (oder Pivot). Deshalb mein VBA-Vorschlag.
Oder sehe ich die Geschichte zu kompliziert?

Erich G.
30.03.2012, 11:53
Hi Saegio,
hier eine Variante, ohne Dictionary, dafür hilfsweise mit Collection:Option Explicit

Sub Auswert2()
Dim arEK, arUE, zz As Long, lngM As Long, arK, cc As Long, arZ() As String
Dim arUK(), ii As Long, colK As New Collection, jj As Long

' Die beiden Quellen können - wie auch die Ergebnisausgabe -
' auf verschiedenen Blättern sein. (Hier ist alles auf einem Blatt.)
arEK = Sheets("Tabelle2").Cells(4, 1).CurrentRegion ' ab Zelle A4: Events/Kateg.
arUE = Sheets("Tabelle2").Cells(1, 5).CurrentRegion ' ab Zelle E1: Ursachen/Events
If UBound(arEK) <> UBound(arUE, 2) Then
MsgBox "Anzahl Events muss bei Kateg. und Ursachen übereinstimmen", _
vbCritical, "Abbruch"
Exit Sub
End If

For zz = 2 To UBound(arEK)
arK = Split(arEK(zz, 2), ",")
ii = UBound(arK)
If lngM < ii Then lngM = ii ' max. Anzahl Kateg. pro Event
Next zz
ReDim arZ(1 To UBound(arEK) - 1, 1 To lngM + 1) ' Array für Kateg. pro Event
For zz = 2 To UBound(arEK)
arK = Split(arEK(zz, 2), ",") ' Splitten des Kateg.-Strings
On Error Resume Next
For ii = 0 To UBound(arK) ' Schleife über Teile
arZ(zz - 1, ii + 1) = arK(ii) ' Kateg. merken zu Event
colK.Add arK(ii), arK(ii) ' Kateg. sammeln ohne Doppelte
Next ii
On Error GoTo 0
Next zz
ReDim arUK(0 To UBound(arUE) - 1, 0 To colK.Count) ' Ergebnisarray
For ii = 1 To UBound(arUK, 2)
arUK(0, ii) = colK(ii) ' Kateg. in Zeile 0
Next ii
For zz = 1 To UBound(arUE) - 1 ' Schleife über Ursachen
arUK(zz, 0) = arUE(zz + 1, 1) ' Ursache in Spalte 0 des Ergebnisses
For cc = 2 To UBound(arUE, 2) ' Schleife über Event-Spalte in Ursache
If Not IsEmpty(arUE(zz + 1, cc)) Then
For ii = 1 To UBound(arZ, 2) ' Schleife über Kateg.-Spalten im Event
For jj = 1 To colK.Count ' Schleife über alle Kateg.
If arZ(cc - 1, ii) = colK(jj) Then ' wenn Kateg. in Event dann
arUK(zz, jj) = arUK(zz, jj) + 1 ' Hochzählen
Exit For
End If
Next jj
Next ii
End If
Next cc
Next zz
' Ausgabe ab Zelle M2
Sheets("Tabelle2").Cells(2, 13).Resize(UBound(arUK) + 1, UBound(arUK, 2) + 1) = arUK
End SubUnd die Mappe dazu...

saegio
30.03.2012, 13:07
Hey ihr seid klasse :)

Erich G., ich habe deine Variante erfolgreich getestet. Funktioniert tadellos. Ich habe nur die CurrentRegions durch explizite Auswahl der Eingabefelder ersetzt, da meine Tabellen ja noch deutlich mehr Informationen enthalten, wie Ort, Datum, Flugzeugtyp etc, hatte der dort etwas Probleme die richtigen Zellen zu erwischen. Funktioniert aber mit range.value nun sehr gut.

Thomas, danke für deinen Vorschlag. Es ist in der Tat so, dass jedes Event beliebig viele Ursachen bzw. Faktoren haben kann. Es gibt dort nicht nur kausalen Faktoren sondern auch sog. circumstancial factors, wie zb schlechtes Wetter/Sicht. Wenn ich das richtig sehe, dann zählst du dort einfach die Anzahl der jeweilgen Kategorie. Erich hat recht, dies habe ich bereits durch ein Zählewenn gelöst.

Erich, kannst du mir den Vorteil deiner 2ten Variante erklären und wenn du schon dabei bist, was eine Collection/Dictionary eigentlich macht? Es wäre auch schön wenn du für einen Anfänger wie mich deine Codes mehr kommentieren würdest, damit ich besser lernen kann was du an welcher Stelle tust:grins:

Jedenfalls, wenn du keinen Grund hast warum die 2te Variante besser ist, dann wäre ich mit deiner ersten schon glücklich :)

Erich G.
31.03.2012, 06:40
Hi Saegio,
hier kommt in der angehängten Mappe noch eine weitere Variante, auch mit Collection und etwas einfacher als die vorige.

Die Collection ist nur eine einfache Sammlung, da gibt es auch in der VBA-Hilfe nicht viel drüber.
Mit
colK.Add arK(ii), arK(ii) ' Kateg. sammeln ohne Doppelte
werden der Sammlung die Kategorien (als Texte) zugefügt.
Das geht gut, wenn eine Kategorie noch nicht in der Sammlung war.
Andernfalls - wenn also etwas geadded werden soll, was schon in der Sammlung steht,
gibt es einen Fehler.
Damit die Prozedur weiterläuft, steht oben drüber
On Error Resume Next
Das bedeutet: Gehe einfach zur nächsten Codezeile, mache weiter.

Damit später mögliche andere Fehler nicht unentdeckt bleiben,
wird nach der Add-Schleife die Fehlerignorierung wieder aufgehoben mit
On Error GoTo 0

In dieser ersten "Schleife über Events" werden die Kategorien in der linken Tabelle eingesammelt.
Danach ist auch (mit colK.Count) klar, wie viele Kategorien es gibt.
Das wird gleich benutzt, um das "Array für Kateg. pro Event" arZ zu dimensionieren.

In der angehängten Mappe ist die Prozedur etwas mehr kommentiert als die letzte.

Es ist etwas schwierig zu entscheiden, wie weit man beim Kommentieren geht.
Ich weiß ja nicht, was für dich einerseits trivial oder andererseits völlig unbekannt ist.

Einfacher wäre es für mich, auf deine konkreten Fragen zum Code einzugehen.
Also: Wenn die Comments nicht ausreichen - frage nach!

saegio
02.04.2012, 11:01
Echt ne coole Sache.

Jetzt würde ich noch gerne wissen wie ich die leeren Matrixkomponenten mit einer "0" auffüllen kann?

Jede Spalte der Ergebnismatrix soll in ein seperates Balkendiagram, wobei ich die Einträge der Größe nach filtern möchen. Das sieht dann einfach schöner und übersichtlicher aus im Diagram. Geht nur schlecht mit den ganzen Leerstellen.

Und zu deinem vorigen Post: Bei mir kannst du wirklich nicht zu viel kommentieren :grins:

Erich G.
02.04.2012, 11:43
Hi Saegio,
0en (nicht "0"en) werden wir nicht auffüllen, stattdessen habe ich nun
arUK() "As Long" deklariert - dann stehen die Nullen von Anfang an automatisch drin.

Dafür musste ich die Zeile 0 und die Spalte 0 aus dem Array herausnehmen - da standen ja Texte drin - Kategorien und Ursachen.
Die sind jetzt in den separaten Arrays arKat und arUrs zu finden.

Alles in der neu beigefügten Mappe. Viel Spaß damit!

saegio
13.04.2012, 04:05
Ok so gut wie fertig. Jetzt habe ich aber ein neues Problem.

Die erste Tabelle enthält nun zusätzliche gruppierte Zeilen zwischen den Einträgen. Also:

Event ID | Unfallkategorie
1............|.......Kat1.............| Text
.............|..........................| Text
.............|..........................| Text
2............|.......Kat5, Kat1....| Text
..............|.........................| Text
3............|.......Kat3............| Text
..............|.........................| Text
..............|.........................| Text
..............|.........................| Text
..............|.........................| Text
4............|.......Kat1, Kat10
..............|.........................| Text
n............|.......Kat2

Ich habe mal eine die ersten 10 Zeilen in einem Beispiel angehängen, damit du weißt was ich meine

Das Problem ist, dass offentsichtlich die Zeile:
arEK = Sheets("Accidents").Range("A2:Bblabla").Value
nun nicht mehr richtig ist.

Diese Matrix müßte sich irgendwie so zusammenbauen, dass nur die Zeilen genommen werden in denen eine ID Nr steht und die Textzeilen ignoriert werden.

Hoffe du kannst mir auch weiterhin weiterhelfen ;)

Erich G.
17.04.2012, 11:03
Hi Saegio,
mit deiner Beispielmappe war nicht so furchtbar viel anzufangen.
Die zweite Tabelle arUE (Ursachen/Events) wird als Datenquelle ja auch noch gebraucht, fehlte aber. :(

Und deinen aktuellen Code hast du auch nicht mitgeschickt. :rolleyes:
Daran hätte ich sehen können, wie du am Anfang für Bereiche für die Quellarrays festlegst.

Nun gut, ich habe eine neue Version gebastelt, in der zuerst die neuen Leerzellen eliminiert werden.
Probier mal:Option Explicit

Sub Auswert5()
Dim arEK(), arUE, zz As Long, lngM As Long, arK, cc As Long, arZ() As Integer
Dim ii As Long, colK As New Collection, jj As Long, lngAE As Long
Dim arUK() As Long, arKat() As String, arUrs() As String
Dim arEEK ' neu: für Events/Kateg. mit Leerzeilen

' Die beiden Quellen können - wie auch die Ergebnisausgabe -
' auf verschiedenen Blättern sein. (Hier ist alles auf einem Blatt.)
With Sheets("Tabelle2")
zz = .Cells(.Rows.Count, 1).End(xlUp).Row ' letzte Zeile in Spalte A
arEEK = .Range(.Cells(4, 1), .Cells(zz, 2)) ' ab Zelle A4: Events/Kateg.
End With
arUE = Sheets("Tabelle2").Cells(1, 5).CurrentRegion ' ab Zelle E1: Ursachen/Events

For zz = 2 To UBound(arEEK) ' Schleife über Events (noch mit Leerzeilen)
If arEEK(zz, 2) <> "" Then
lngAE = lngAE + 1
arK = Split(arEEK(zz, 2), ",") ' Kateg-String zerlegen nach Kommata
On Error Resume Next
For ii = 0 To UBound(arK) ' Schleife über Teile
colK.Add arK(ii), arK(ii) ' Kateg. sammeln ohne Doppelte
Next ii
On Error GoTo 0
End If
Next zz
If lngAE <> UBound(arUE, 2) - 1 Then
MsgBox "Events müssen bei Kateg. und Ursachen übereinstimmen", _
vbCritical, "Abbruch"
Exit Sub
End If
ReDim arEK(1 To lngAE + 1, 2) ' Array für Events/Kateg. ohne Leerzeilen
lngAE = 0
For zz = 1 To UBound(arEEK) ' Events/Kateg. ohne Leerzeilen erstellen
If arEEK(zz, 2) <> "" Then
lngAE = lngAE + 1
arEK(lngAE, 1) = arEEK(zz, 1)
arEK(lngAE, 2) = arEEK(zz, 2)
End If
Next zz
ReDim arZ(1 To UBound(arEK) - 1, 1 To colK.Count) ' Array für Kateg. pro Event
For zz = 2 To UBound(arEK) ' Schleife über Events
arK = Split(arEK(zz, 2), ",") ' Splitten des Kateg.-Strings
For ii = 0 To UBound(arK) ' Schleife über Teile
For jj = 1 To colK.Count ' Schleife über Kateg-Sammlung
If colK(jj) = arK(ii) Then ' wenn Kateg. gefunden
arZ(zz - 1, jj) = 1 ' Kateg-Pos. merken zu Event
Exit For
End If
Next jj
Next ii
Next zz
ReDim arUK(1 To UBound(arUE) - 1, 1 To colK.Count) ' Ergebnisarray
ReDim arKat(1 To 1, 1 To colK.Count) ' Kategorien für Ausgabe
For ii = 1 To colK.Count
arKat(1, ii) = colK(ii) ' Kategorien für Ausgabe
Next ii
ReDim arUrs(1 To UBound(arUE) - 1, 1 To 1) ' Ursachen für Ausgabe
For zz = 1 To UBound(arUE) - 1 ' Schleife über Ursachen
arUrs(zz, 1) = arUE(zz + 1, 1) ' Ursachen für Ausgabe
For cc = 2 To UBound(arUE, 2) ' Schleife über Event-Spalte in Ursache
If Not IsEmpty(arUE(zz + 1, cc)) Then
For ii = 1 To UBound(arZ, 2) ' Schleife über Kateg.-Spalten im Event
If arZ(cc - 1, ii) > 0 Then ' wenn Kateg. belegt
arUK(zz, ii) = arUK(zz, ii) + 1 ' Hochzählen
End If
Next ii
End If
Next cc
Next zz
With Sheets("Tabelle2") ' Ausgaben ab Zelle M2
.Cells(2, 14).Resize(, UBound(arKat, 2)) = arKat
.Cells(3, 13).Resize(UBound(arUrs)) = arUrs
.Cells(3, 14).Resize(UBound(arUK), UBound(arUK, 2)) = arUK
End With
End Sub

saegio
20.04.2012, 17:16
Großartig wie einem hier geholfen wird. Ist alles sehr sehr hilfreich für mich. Die Beispieltabelle diente nur der Veranschauung meiner äußerst holprigen Erklärung :D

saegio
23.04.2012, 13:57
Erich G bist du heute online?

Hab noch ein ähnliches Problem

Ich habe ein Array definiert, dass bei Ausgabe so aussieht wie im Anhang (Tabelle1).

Auf Tabelle2 habe ich versucht für jede Kategorie (zB CFIT, ARC, etc.) die Anzahl der jeweiligen Maßnahme zu zählen (zb SKYbrary - CFIT oder FOBN - Standard Calls).

Mit den Summenprodukten geht das leider nur für die Zeilen in denen tatsächlich eine Kategorie steht aber nicht für die Zeilen zwischen den Kategorien.

Wie kann ich das lösen?