AW: Bei Zeilenklick auf Eintrag
21.01.2006 22:56:22
Matthias
Hallo Heinz,
Option Explicit
Private Sub SuchenButton_Click()
Const z1 = 4 'erste Suchzeile
Dim shK As Worksheet
Dim z As Long, z0 As Long, i As Long, lz As Long
Dim blatt As Integer
Dim Datum As Date, BText As String, Valuta As Date, Betrag As Double
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 wohl 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
Datum = CDate(.Cells(z, 1))
If Err.Number > 0 Then
MsgBox "Fehler in Blatt " & .Name & ", Zeile" & z
Exit Sub
End If
On Error GoTo 0
Valuta = .Cells(z, 3)
Betrag = .Cells(z, 4)
BText = ""
Do
BText = BText & " " & .Cells(z, 2)
z = z + 1
Loop Until .Cells(z, 1) <> "" Or z > lz
BText = Mid(BText, 2)
'Filter:
If InStr(UCase(BText), UCase(Range("Suchtext"))) > 0 Then
Cells(z0, 1) = Datum
Cells(z0, 2) = BText
Cells(z0, 3) = Valuta
Cells(z0, 4) = Betrag
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
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column = 1 And Cells(Target.Row, 5) <> "" Then
Cancel = True
Application.Goto reference:=Sheets(Target.Offset(0, 4).Text).Cells(Target.Offset(0, 5), 1)
End If
End Sub
Ein Rechtsklick auf das Datum lässt dich zur Datenquelle springen.
Gruß Matthias