Such-Auswertung

Guten Tag miteinander
Mal wieder hoffe ich von Euch Profis Ratschläge und Unterstützung bei der Umsetzung meines Vorhabens zu erhalten.
Und zwar gehts darum:
In einer Excel-Arbeitsmappe (siehe beiliegende Musterdatei) gibts drei Tabellenblätter. Auf dem 1. Tabellenblatt (Probleme)
werden laufend (d.h. einmal pro Monat) verschiedene Problemfälle erfasst
Auf dem zweiten Tabellenblatt (Such-Kriterien) sind die verschiedenen Artikelnummern (oder eben Suchkriterien) erfasst.
Diese Suchkriterien können erweitert werden um weitere Artikel-Nummern
Auf dem dritten Tabellenblatt (Auswertung) soll letztendlich eine Auswertung erstellt werden können, wie im Beispiel dargestellt.
https://www.herber.de/bbs/user/82904.xlsm
D.h. ich suche eine Makro Lösung, die mir auf Knopfdruck aus den Problemfällen (Tabellenblatt PROBLEME) alle Artikel aus dem zweiten Tabellenblatt
(SUCH-KRITERIEN) raussucht und schliesslich auf dem dritten Tabellenblatt (AUSWERTUNG) eine Auflistung pro Suchkriterium erstellt.
Geht das irgendwie ?
Ich denke da braucht es Do-while Loops oder For-Next Schlaufen ?
Leider aber bin ich damit noch zuwenig vertraut.
Darum erbitte ich eure Profi-Hilfe.
Im voraus besten Dank euch allen.

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Such-Auswertung

05.12.2012 12:02:04

Ludicla

AW: Such-Auswertung

05.12.2012 12:51:17

Pascal

AW: Such-Auswertung

05.12.2012 12:05:45

ransi

AW: Such-Auswertung

07.12.2012 07:58:05

Pascal

AW: Such-Auswertung

07.12.2012 14:18:22

Pascal

AW: Such-Auswertung

08.12.2012 12:55:22

ransi

AW: Such-Auswertung

10.12.2012 08:26:55

Pascal

AW: Such-Auswertung

11.12.2012 11:11:42

Pascal

Mittlerweilen hab ichs doch noch geschafft, meine Auswertung mit folgendem Code zum Laufen zu bringen:
Option Explicit

Public Sub Auswertung()
Dim arrIn As Variant
Dim ArrKriterien As Variant
Dim arrOut As Variant
Dim L As Long
Dim lngCount As Long
Dim lngIndex As Long
arrIn = Sheets("Probleme").Range("A1").CurrentRegion
ArrKriterien = Sheets("Such-Kriterien").Range("A3:A26") 'Anpassen
ReDim arrOut(1 To UBound(arrIn), 1 To UBound(arrIn, 2) + 1)
For L = LBound(ArrKriterien) To UBound(ArrKriterien)
For lngCount = 1 To UBound(arrIn)
If InStr(1, arrIn(lngCount, 6), ArrKriterien(L, 1)) Then  'Der Wert 6 zeigt in die  _
Spalte, in welcher gesucht wird
lngIndex = lngIndex + 1
arrOut(lngIndex, 1) = ArrKriterien(L, 1)
arrOut(lngIndex, 2) = arrIn(lngCount, 1)
arrOut(lngIndex, 3) = arrIn(lngCount, 2)
arrOut(lngIndex, 4) = arrIn(lngCount, 3)
arrOut(lngIndex, 5) = arrIn(lngCount, 4)
arrOut(lngIndex, 6) = arrIn(lngCount, 5)
arrOut(lngIndex, 7) = arrIn(lngCount, 6)
arrOut(lngIndex, 8) = arrIn(lngCount, 7)
arrOut(lngIndex, 9) = arrIn(lngCount, 8)
arrOut(lngIndex, 10) = arrIn(lngCount, 9)
arrOut(lngIndex, 11) = arrIn(lngCount, 10)
arrOut(lngIndex, 12) = arrIn(lngCount, 11)
arrOut(lngIndex, 13) = arrIn(lngCount, 12)
arrOut(lngIndex, 14) = arrIn(lngCount, 13)
End If
Next
Next
Sheets("Auswertungen").Range("A3:O" & lngIndex) = arrOut
End Sub

Was mir jetzt aber noch fehlt:
Die Code-Zeile "If InStr(1, arrIn(lngCount, 6), ArrKriterien(L, 1)) Then " soll so erweitert werden, dass nicht bloss in der Spalte 6 - sondern auch noch in der Spalte 15 nach Kriterien gesucht wird.
D.h. Wird das Suchkriterium, welches in der Variable "ArrKriterien" daherkommt entweder in Spalte 6 oder in Spalte 15 (oder gar in beiden Spalten) gefunden, dann .....
Des weiteren such nich noch nach einer Möglichkeit, in der Auswertung (Tabellenblatt AUSWERTUNG) dann vor jedem Kriteriums-Wechsel (also vor Wechsel eines Artikels) noch eine Leerzeile einzufügen.
Jede Artikelnummer soll nur einmal in die Spalte A geschrieben werden, darunter aber dann jeweils alle gefundenen Problemfälle zu diesem Artikel.
Ginge das irgendwie ?
Danke herzlich

Public Sub Auswertung() Dim arrIn As Variant Dim ArrKriterien As Variant Dim arrOut As Variant Dim L As Long Dim lngCount As Long Dim lngIndex As Long Dim CI_Text_11 As String arrIn = Sheets("Probleme").Range("A1").CurrentRegion ArrKriterien = Sheets("Such-Kriterien").Range("A3:A26") 'Anpassen ReDim arrOut(1 To UBound(arrIn), 1 To UBound(arrIn, 2) + 1) For L = LBound(ArrKriterien) To UBound(ArrKriterien) For lngCount = 1 To UBound(arrIn) CI_Text_11 = Mid(arrIn(lngCount, 15), 1, 11) 'liest aus der Spalte O (CI) die ersten 11 _ Zeichen aus If InStr(1, arrIn(lngCount, 6), ArrKriterien(L, 1)) Or _ InStr(1, CI_Text_11, ArrKriterien(L, 1)) Then 'Der Wert 6 und 15 zeigt in die Spalte, _ in welcher gesucht wird lngIndex = lngIndex + 1 arrOut(lngIndex, 1) = ArrKriterien(L, 1) arrOut(lngIndex, 2) = arrIn(lngCount, 1) arrOut(lngIndex, 3) = arrIn(lngCount, 2) arrOut(lngIndex, 4) = arrIn(lngCount, 3) arrOut(lngIndex, 5) = arrIn(lngCount, 4) arrOut(lngIndex, 6) = arrIn(lngCount, 5) arrOut(lngIndex, 7) = arrIn(lngCount, 6) arrOut(lngIndex, 8) = arrIn(lngCount, 7) arrOut(lngIndex, 9) = arrIn(lngCount, 8) arrOut(lngIndex, 10) = arrIn(lngCount, 9) arrOut(lngIndex, 11) = arrIn(lngCount, 10) arrOut(lngIndex, 12) = arrIn(lngCount, 11) arrOut(lngIndex, 13) = arrIn(lngCount, 12) arrOut(lngIndex, 14) = arrIn(lngCount, 13) arrOut(lngIndex, 15) = arrIn(lngCount, 14) arrOut(lngIndex, 16) = arrIn(lngCount, 15) End If Next Next Sheets("Auswertungen").Range("A3:P" & lngIndex) = arrOut End Sub

Beliebteste Forumthreads (12 Monate)

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread