Union

Hallo zusammen
Aus einer Tabelle mit unterschiedlichen Daten muss ich eine Auswertung machen.
Vereinfacht habe ich ein Muster erstellt.
https://www.herber.de/bbs/user/63339.xls
In Blatt 1 muss ermittelt werden, ob innerhalb a (Zeilen 2 bis 8) in Spalte B immer das Kriterium "ja" erfüllt ist, wenn in Spalte F "alle" steht. Das heisst, die Zeilen mit "keine" in Spalte F dürfen nicht berücksichtigt werden. Dieselbe Ermittlung erfolgt ebenso bei b (Zeilen 9 bis 11), usw.
Das Ergebnis der Ermittlung erfolgt im Blatt 2 (vereinfachter Zusammenzug mit einer Zeile pro a, b, c, usw) mit:
- "ja" wenn in Blatt 1 Spalte B unter a (Zeilen 2 bis 8) alle Zellen = "ja" (aber ohne Berücksichtigung wenn in Spalte F "keine")
- "teilw" sobald in Blatt 1 Spalte B unter a (Zeilen 2 bis 8) eine oder mehrere Zellen = "nein" und/oder "teilw" (aber ohne Berücksichtigung wenn in Spalte F "keine")
Im Blatt 2 gibt es dementsprechend nur "ja" oder "teilw"
Wie könnte ich diese Zusammenstellung in Blatt 2 aus Blatt 1 per VBA vornehmen. Es handelt sich um eine umfangreiche Tabelle.
Vielen Dank für eure Hilfe
Gruss Gregor

Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Benutzer

Hallo Gregor,
hier wäre ein Makro für Dich. Achtung: Wunschgemäß berücksichtigt es NICHT die Möglichkeit, dass unter einem Buchstaben keine "Alle"-Zeile steht. Es wird auch nicht "nein" eingetragen, wenn KEINE der "Alle"-Zeilen ein "ja" beinhaltet. Die Logik ist also so, dass erstmal "ja" angenommen wird, bis eine Störung auftritt.
Gruß, Wolli

Sub Auswerten()
Dim lngLeseZeile As Long, _
lngSchreibZeile As Long, _
shLeseBlatt As Worksheet, _
shSchreibBlatt As Worksheet, _
blnStatus As Boolean, _
strBuchstabe As String
'Lese- und Schreibblatt festlegen,
'Startzeilen festlegen
Set shLeseBlatt = Sheets("Blatt 1")
Set shSchreibBlatt = Sheets("Blatt 2")
lngLeseZeile = 2
lngSchreibZeile = 2
Do
'Buchstaben merken
strBuchstabe = Cells(lngLeseZeile, 1)
'Für neuen Buchstaben den Status "ja" setzen
blnStatus = True
'Einen Buchstaben durchnudeln
Do
'Status aberkennen, wenn in einer "alle"-
'Zeile nicht "ja" steht
If shLeseBlatt.Cells(lngLeseZeile, 6) = "alle" And _
shLeseBlatt.Cells(lngLeseZeile, 2)  "ja" Then
blnStatus = False
End If
lngLeseZeile = lngLeseZeile + 1
'Fertig, wenn in Spalte A wieder ein Inhalt auftaucht
'oder in Spalte B keine Daten mehr stehen
Loop Until shLeseBlatt.Cells(lngLeseZeile, 1)  "" Or _
shLeseBlatt.Cells(lngLeseZeile, 2) = ""
'Auswerten und eintragen
shSchreibBlatt.Cells(lngSchreibZeile, 1) = strBuchstabe
If blnStatus Then
shSchreibBlatt.Cells(lngSchreibZeile, 2) = "ja"
Else
shSchreibBlatt.Cells(lngSchreibZeile, 2) = "teilw"
End If
lngSchreibZeile = lngSchreibZeile + 1
'Beenden, wenn in Spalte B keine Daten mehr stehen
Loop Until shLeseBlatt.Cells(lngLeseZeile, 2) = ""
End Sub

Beliebteste Forumthreads (12 Monate)

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread