Filter/Datensätze # Uwe(et999)

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hi Ingo,
Deine Punkte 1. und 4. kann ich zusammen beantworten. Wenn Du beim Klicken auf den Knopf die Strg-Taste gedrückt hälst, kannst Du ihn bearbeiten, also Text ändern, verschieben (Rahmen anfassen), Größe ändern etc. Mit der rechten Maustaste kommst Du ins Eigenschaften Menü, wo noch mehr möglich ist.
Zu 2.: Du hast recht, in dem Code waren "Überbleibsel" aus der "Zeit" als es noch die Inputbox gab. Habe in jetzt "entmüllt".
Zu 5.: Das war mit vorher nicht aufgefallen. Habe den Code dementsprechend geändert:
https://www.herber.de/bbs/user/30687.xls
Zu 3.: Öffne die Tabelle in die Du den Filter einfügen willst. Drücke Alt & F11. Ein Fenster mit der VBA-Umgebung geht auf. Klicke auf Einfügen/ Modul. Es öffnet sich ein Fenster in dem entweder gar nichtst, oder, wahrscheinlicher: Option Explicit steht. Kopiere den Code (s.u.) und füge ihn nach Option Explicit ein (wenn's nicht da steht, nur den Code einfügen).
Jetzt kannst Du die VBA-Umgebung schließen, das Makro ist installiert.
Wahrscheinlich fehlt dir jetzt noch der Knopf:
Klicke in Deiner Tabelle auf Ansicht/Symbolleisten/Formular. Klicke auf den Knopf (Schaltfläche) und ziehe mit der Maus einen Rahmen an der Stelle und in der Größe wo und wie Du den Knopf haben willst. Dann erscheint ein Fenster "Makro zuweisen". Da klickst Du auf unser Marko: Filter. OK. Fertig.
Wie man den Knopf weiter bearbeitet habe ich ja oben schon beschrieben.
Ich hoffe ich habe nichts vergessen.
Gruß
Uwe
(:o)

Sub Filter()
Application.ScreenUpdating = False
Dim Zelle As Range
Dim strName As String
Dim Reihe As Integer
Dim I As Long
Dim SatzNummer As String
Range("A2:IV65536").AutoFilter         'mit A2 ist die 2te Zeile festgelegt
Range("A2:IV65536").AutoFilter         'bei Bedarf auf 3 usw. ändern
For I = 3 To ActiveSheet.UsedRange.Rows.Count
   If Cells(I, 1).EntireRow.Hidden = True Then
      Cells.EntireRow.Hidden = False
      Range("A1").Select
      Exit Sub
   End If
Next I
strName = ActiveCell.Value
For I = 3 To ActiveSheet.UsedRange.Rows.Count
   Cells(I, 1).EntireRow.Hidden = True
Next I
If strName = "" Then Exit Sub
For Each Zelle In ActiveSheet.UsedRange
   If Zelle.Value = strName Then
      Reihe = Zelle.Row
         Do Until Left(Cells(Reihe, 2).Value, 5) = "Daten"
            Reihe = Reihe - 1
         Loop
            SatzNummer = Cells(Reihe, 1).Value
         Do While Cells(Reihe, 1).Value = SatzNummer
         Cells(Reihe, 1).EntireRow.Hidden = False
         Reihe = Reihe + 1
         Loop
    End If
Next Zelle
Cells(1, 1).Select
Application.ScreenUpdating = True
End Sub

Hi Ingo,
ich hab' den Fehler dank Deines Beispiels gefunden. So klappt es:
https://www.herber.de/bbs/user/30737.xls
Das Problem waren die Zellen in der Spalte C mit der Fehlermeldung #BEZUG!
Da hat er sich aufgehängt, denn String, also Zeichenkette ist irgendeine Reihe von Zeichen egal ob Zahlen oder Nummern. Ich dachte eigentlich in einer Zelle kann ja nichts anderes stehen. Auch Formeln sind da kein Problem. Aber #BEZUG! ist für Excel ebend kein String, sondern eine Fehlermeldung!!! Hab ich mal wieder was gelernt.
Mit den beiden neuen Zeilen im Code frage ich ab, ob es eine Fehlermeldung ist und springe dann einfach zur nächsten Zelle:

Sub Filter()
Application.ScreenUpdating = False
Dim Zelle As Range
Dim strName As String
Dim Reihe As Integer
Dim I As Long
Dim SatzNummer As String
Range("A3:IV65536").AutoFilter         'mit A2 ist die 2te Zeile festgelegt
Range("A3:IV65536").AutoFilter         'bei Bedarf auf 3 usw. ändern
For I = 3 To ActiveSheet.UsedRange.Rows.Count
   If Cells(I, 1).EntireRow.Hidden = True Then
      Cells.EntireRow.Hidden = False
      Range("A1").Select
      Exit Sub
   End If
Next I
strName = ActiveCell.Value
For I = 3 To ActiveSheet.UsedRange.Rows.Count
   Cells(I, 1).EntireRow.Hidden = True
Next I
If strName = "" Then Exit Sub
For Each Zelle In ActiveSheet.UsedRange
   If IsError(Zelle.Value) Then GoTo EndeIF '   NEU
   If Zelle.Value = strName Then
      Reihe = Zelle.Row
         Do Until Cells(Reihe, 1) <> Cells(Reihe, 1).Offset(-1, 0)
         Reihe = Reihe - 1
         Loop
            SatzNummer = Cells(Reihe, 1).Value
         Do While Cells(Reihe, 1).Value = SatzNummer
         Cells(Reihe, 1).EntireRow.Hidden = False
         Reihe = Reihe + 1
         Loop
    End If
EndeIF:                                                                 'NEU
Next Zelle
Cells(1, 1).Select
Application.ScreenUpdating = True
End Sub

So, das Beispiel klappt jetzt, ich hoffe in Deinem Original haut das auch hin.
Also mal wieder: DAUMEN DRÜCKEN!!!
Gruß
Uwe
(:o)

Beliebteste Forumthreads (12 Monate)

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Filter/Datensätze # Uwe(et999)

12 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread