Gefilterte Datensätze Markieren !

[RPP63]

Ich hatte gerade etwas Langeweile …
Deshalb obiges Verfahren als Makro:

Sub FilterX()
Dim Suchfilter
Suchfilter = Application.InputBox("Suchfilter:", Type:=1)
If Suchfilter <> False Then
  With Tabelle1.ListObjects("Tab_Daten")
    .Range.AutoFilter 3, "*" & Suchfilter & "*"
    On Error Resume Next
    .ListColumns(2).DataBodyRange.SpecialCells(xlCellTypeVisible).Value = "x"
    On Error GoTo 0
    .Range.AutoFilter 3
  End With
End If
End Sub

[Foregner]

Hallo !

In der Originaltabelle Filtern bringt mich nicht weiter, da mein Beispiel nur ein kleiner teil eines größeren ist.
Werde mich heute Abend hinsetzen, und deine VBA Lösung versuchen umzusetzen.
vielen Dank dafür, melde mich dann....

LG

[RPP63]

Dann nimm mal nicht das Makro, sondern dieses kleine Programm.
(der Unterschied sollte klar sein)


Modul Modul1

Option Explicit 
 
Sub FilterX() 
Dim Suchfilter 
Suchfilter = Application.InputBox("Suchfilter:", Type:=1) 
Application.ScreenUpdating = False 
If Suchfilter <> False Then 
  With Tabelle1.ListObjects("Tab_Daten") 
    .Range.AutoFilter 3, "*" & Suchfilter & "*" 
    On Error Resume Next 
    With .ListColumns(2).DataBodyRange.SpecialCells(xlCellTypeVisible) 
      If .Count = 0 Then 
        Call HelpMsg(1, Suchfilter) 
      Else 
        .Value = "x" 
        Call HelpMsg(3, Suchfilter, .Count) 
      End If 
    End With 
    On Error GoTo 0 
    .Range.AutoFilter 3 
  End With 
Else 
  Call HelpMsg(2) 
End If 
End Sub 
 
Sub HelpMsg(i%, Optional ByVal Suchfilter$, Optional ByRef k%) 
Select Case i 
  Case 1 
    MsgBox "Das Suchkriterium """ & Suchfilter & """ wurde nicht gefunden!" 
  Case 2 
    MsgBox "Suchkriterium fehlt!" 
  Case 3 
    MsgBox "Es werden " & k & " Datensätze markiert," & Chr(10) & _
          "die den Suchkriterien """ & Suchfilter & """ entsprechen!" 
End Select 
End Sub 

[Elex]

Hi
 
Da ich nicht alle Umstände deines Vorhabens kenne hier mein Vorschlag passend zu deiner Anfrage. Warum der Umweg über die zweite Liste sein muss und nicht mit der Teileliste gearbeitet werden kann, kannst nur du beantworten.

  alle x Merken.xlsm (Größe: 21,29 KB / Downloads: 3)
 
Gruß Elex

[Foregner]

@Elex, Wow das ist sogar noch viel besser wie angedacht, Funktioniert Super.
recht Herzlichen Dank.

@RPP63, Dir auch ein Dankeschön.

zum Verständnis: Ich muss den Umweg über die zweite Tabelle machen, da sich da Einträge mehrere Tabellen vereinen.
Das alles in einer Tabelle unterzubringen, wäre sehr unübersichtlich.

LG Gerhard

[Elex]

Hi

Ok. Wenn das so für dich passt. Habe den Code noch mal etwas geändert. Wenn du einzelne Einträge in Spalte N von Hand löscht kommt er so besser damit klar.

Code:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim Werte As Variant
Dim i, n, k As Long

If Not Application.Intersect(Target, Columns(11)) Is Nothing Then
   If Target.Value = "x" Then
      k = Cells(Rows.Count, 14).End(xlUp).Row
      Werte = Range("N4:N" & k).Value
      Range("N5:N" & k).ClearContents
      For i = 2 To k - 3
        If Target.Offset(0, -3).Value <> Werte(i, 1) And Werte(i, 1) <> "" Then
          Cells(n + 5, 14).Value = Werte(i, 1)
          n = n + 1
        End If
      Next i
   Else
     Range("N" & Cells(Rows.Count, 14).End(xlUp).Row + 1).Value = Target.Offset(0, -3).Value
   End If
   Cancel = True
End If

End Sub

Gruß Elex

[Foregner]

@Elex, Super Danke.

PS:Ist schon Wahnsinn was Du/ihr alles drauf habt, echt Hut ab.Und das du/ihr Leuten wie mir helft, was mit Sicherheit nicht selbsverständlich ist. dafür Einfach mal ein Dickes Dankeschön.