Fehler in Suchmakro
17.02.2008 19:47:59
Heinz
Habe ein Makro wenn ich im Sheets1 (Name ist Suche) im Suchtextfeld B3 einen Begriff eingebe mir alle Werte die diesen Begriff enthalten ausgeben.
Leider funkt es nicht so wie ich möchte.
Es ist für meine MP3 Sammlung.
In den Spalten A ist immer der Interpret: In Spalten B immer der Titel: In spalte C das Jahr: Und in Spalte D der Hyperlink
Könnte mir dazu bitte jemand weiterhelfen.
Danke und Gruß Heinz
Option Explicit
Private Sub SuchenButton_Click()
Const z1 = 3 'erste Suchzeile
Dim shK As Worksheet
Dim z As Long, z0 As Long, i As Long, lz As Long
Dim blatt As Integer
Dim Interpret As String, Jahr As String, Titel As String, Hyperlink As String
z0 = 7 'erste Ausgabezeile in "Suche"
Me.Rows(z0 & ":" & Rows.Count).ClearContents
Columns("E:F").Hidden = True
'ab Blatt 2 bis zum letzten (1 ist das Suchblatt)
For blatt = 2 To ThisWorkbook.Sheets.Count
Set shK = Sheets(blatt)
With shK
z = z1
lz = .Cells(Rows.Count, 1).End(xlUp).Row
Do
'Datensatz ermitteln:
On Error Resume Next
Interpret = .Cells(z, 1)
If Err.Number > 0 Then
MsgBox "Fehler in Blatt " & .Name & ", Zeile" & z
Exit Sub
End If
On Error GoTo 0
Jahr = .Cells(z, 3)
Hyperlink = .Cells(z, 4)
Do
z = z + 1
Loop Until .Cells(z, 1) "" Or z > lz
'Filter:
If InStr(UCase(Titel), UCase(Range("Suchtext"))) > 0 Then
Cells(z0, 1) = Interpret
Cells(z0, 2) = Titel
Cells(z0, 3) = Jahr
Cells(z0, 4) = Hyperlink
'Cells(z0, 5) = shK.Name
'Cells(z0, 6) = z - 1
z0 = z0 + 1
End If
Loop Until z > lz
End With
Next blatt
End Sub