Konto Daten Abfragen

Heinz · 2006-01-20T10:47:13+00:00

Hallo Leute Ich bräuchte für meine Kontoverwaltung,eine Abrage wie oft dieses Wort vorkommt dann Anzeigen. Zb. in Tab.Blatt Jän. 02 in Zellen B steht der Text zum Abfragen. Nun möchte ich in einem neuen Tab.Blatt die Daten wenn Übereinstimmungen vorhanden.Die dazugehörigen Daten in Zelle A + C +D. Leider sind die Daten in Spalte B oft 2 bis 4 Zeilig. Ich möchte damit einfach sehen wie oft Zb. "Rundfunkgebühren" schon bezahlt wurden Oder hätte jemand vielleicht eine andere Idee ? Danke & Gruss,Heinz Habe mal eine Beispieldatei hochgeladen. https://www.herber.de/bbs/user/30225.xls

Hallo Heinz,
ich hab mir schon gedacht, dass das über mehrere Blätter geht ;-)
Da muss einfach noch ne Schleife rum:


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
'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:
Datum = .Cells(z, 1)
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
z0 = z0 + 1
End If
Loop Until z > lz
End With
Next blatt
End Sub

Gruß Matthias

Hallo Matthias
Hab ich das richtig eingefügt ?
Kommt noch immer Fehler.
Oder Sollte ich in jedem Tab.Blatt die Überschrift löschen?
Danke 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
'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
On Error Resume Next
Datum = CDate(.Cells(z, 1))
If Err.Number > 0 Then Datum = CDate("9.9.1999")
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
z0 = z0 + 1
End If
Loop Until z > lz
End With
Next blatt
End Sub

Forumthread: Konto Daten Abfragen

18
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Konto Daten Abfragen

Forumthread: Konto Daten Abfragen

18 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

18
Beiträge zum Forumthread

Beiträge zu diesem Forumthread