Tabelleinhalt über 2 Variablen auslesen
19.11.2023 16:32:07
Klaus Maier
Ich verwende für die Verwaltung bzw. Archivierung meiner CD-Sammlung eine Excel-Arbeitsmappe mit Makros.
Jeder CD werden spalten- und zeilenweise Attribute, beispielsweise zu den Musikern und deren Instrumente oder den Songtiteln zugeordnet. 1 CD-Datensatz umfasst dabei so viele Zeilen, wie für die Erfassung der Musiker bzw. Songs erforderlich ist. Allen Datenzeilen einer CD wird dabei in Spalte A ein eindeutiger Schlüssel, sozusagen eine ID zugeordnet.
Beispieldatei: https://www.herber.de/bbs/user/164438.xlsm
Um z.B. festzustellen, auf welchen CDs ein bestimmter Musiker mitspielt, verwende ich seit einigen Jahren ein Filtermakro, bei dessen Erstellung mir die Community im Herber-EXCEL-Forum netterweise sehr unter die Arme gegriffen hat.
Dabei passiert folgendes: Der Musikername in der markierten Zelle in Spalte H wird in einer Schleife als Variable verwendet, und alle Zeilen meines Archivs, in denen dieser Suchbegriff vorkommt, werden ausgelesen und in einer eigenen Auswertungstabelle zusammengefasst.
Private Sub SuBe_Auswertung_Test()
Dim inRoQ As Long, inRoZ As Long, i As Long, eZ As Long
Dim blaNaQ As String, blaNaZ As String
Dim SuBe As Variant
Dim konvSuBe As Variant
On Error GoTo TestError
SuBe = ActiveCell.Value
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets("CDA").Select
Cells.Select
Selection.Copy
Sheets.Add
ActiveSheet.Name = "Filter_TEMP"
Cells.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
blaNaQ = ActiveSheet.Name
Sheets("CDA").Select
Application.CutCopyMode = False
Range("A2:Q2").Select
Range("A3").Select
If SuBe = "" Then
MsgBox "Makro-Abbruch wegen fehlendem Suchbegriff" & Chr(10) & _
" oder Drücken der Abbrechen-Taste !", , _
"MAKROABBRUCH"
Sheets(blaNaQ).Delete
Exit Sub
End If
Application.ScreenUpdating = False
konvSuBe = (UCase(SuBe))
blaNaZ = "SuBe " & konvSuBe
Sheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = blaNaZ
Sheets(blaNaQ).Select
inRoQ = Cells(Rows.Count, 2).End(xlUp).Row
eZ = 0
For i = 1 To inRoQ Step 1
If InStr(UCase(Cells(i, 8).Value), konvSuBe) > 0 Then
eZ = eZ + 1
With Worksheets(Sheets.Count)
inRoZ = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
If eZ = 1 Then inRoZ = 1
.Cells(inRoZ, 1).Value = Cells(i, 1).Value
.Cells(inRoZ, 2).Value = Cells(i, 2).Value
.Cells(inRoZ, 3).Value = Cells(i, 3).Value
.Cells(inRoZ, 4).Value = Cells(i, 4).Value
.Cells(inRoZ, 5).Value = Cells(i, 5).Value
.Cells(inRoZ, 6).Value = Cells(i, 6).Value
.Cells(inRoZ, 7).Value = Cells(i, 7).Value
.Cells(inRoZ, 8).Value = Cells(i, 8).Value
.Cells(inRoZ, 9).Value = Cells(i, 9).Value
.Cells(inRoZ, 10).Value = Cells(i, 10).Value
.Cells(inRoZ, 11).Value = Cells(i, 11).Value
.Cells(inRoZ, 12).Value = Cells(i, 12).Value
.Cells(inRoZ, 13).Value = Cells(i, 13).Value
.Cells(inRoZ, 14).Value = Cells(i, 14).Value
End With
End If
Next i
Sheets(blaNaZ).Select
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("D1").Value = "SuBe: " & SuBe
If eZ = 0 Then
MsgBox _
"Es wurden keine Zellen mit dem Suchbegriff *" & konvSuBe & "* gefunden !", , _
"SuBe"
Application.DisplayAlerts = False
Sheets(blaNaQ).Delete
Sheets(blaNaZ).Delete
Sheets("CDA").Select
Application.DisplayAlerts = True
Else
MsgBox _
"Es wurde(n) folgende Zeile(n) mit dem Suchbegriff *" & konvSuBe & "* gefunden !", , "SuBe"
Sheets(blaNaQ).Delete
Sheets(blaNaZ).Select
Range("A2:Q2").Select
Range("B3").Select
End If
Exit Sub
TestError:
Application.DisplayAlerts = True
Sheets(blaNaQ).Delete
Sheets(blaNaZ).Delete
MsgBox "Eine Auswertung für den Suchbegriff *" & konvSuBe & "* liegt bereits vor!"
Sheets("SuBe " & konvSuBe).Select
End SubNun zu meiner Frage bzw. meiner Bitte an Euch.
Kann mir jemand dabei helfen diese Schleife so zu erweitern, dass nicht nur jene Zeilen ausgelesen werden, in denen der Suchbegriff auch tatsächlich vorkommt, sondern alle Zeilen einer CD, in denen dieser Suchbegriff auftaucht.
Also, der Musikername taucht z.B. in den CDs mit den laufenden Nummern 1707; 1474; 1708 auf und die Schleife soll jetzt alle Zeilen mit diesen laufenden Nummern auslesen.
Oder anders gesagt:
Jene Zeilen, die den Suchbegriff in Spalte H enthalten, haben in Spalte A jeweils eine LFD_NR stehen. Die Scheife soll nun alle Zeilen auslesen, in denen diese Nummer/Nummern vorkommen.
Vorab herzlichen Dank für eure Bemühungen
Klaus