hi gerd :-)

wie gewuenscht fuer die spalten

gruss nighty

spaltenfilter in wechselwirkung
mehrere kreterien angebbar ,durch leerzeichen getrennt

z.b.
1 kreterium
Schraube

2 kreterien
schraube holz

3 kreterien
schraube holz putz

usw.

Option Explicit
Sub makro01()
Application.EnableEvents = False
Dim spaltende As Integer
Dim zaehler1 As Integer
Dim zaehler2 As Integer
Dim zaehler3 As Integer
Dim spalten As Integer
Dim EinGabe As String
ReDim sammel(1) As String
ReDim zaehler4(spalten) As Boolean
spalten = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column
With ActiveSheet
If .Range("B1:IV1").EntireColumn.Hidden = True Then
.Range("B1:IV1").EntireColumn.Hidden = False
End
End If
EinGabe = InputBox("Eingabe des Monats")
zaehler2 = 1
For zaehler1 = 1 To Len(EinGabe)
If Mid(EinGabe, zaehler1, 1) <> " " Then
sammel(zaehler2) = sammel(zaehler2) + Mid(EinGabe, zaehler1, 1)
Else
zaehler2 = zaehler2 + 1
ReDim Preserve sammel(zaehler2)
End If
Next zaehler1
.Range("B1:IV1").EntireColumn.Hidden = False
For zaehler1 = 2 To spalten
For zaehler3 = 1 To zaehler2
If UCase(Cells(1, zaehler1)) <> UCase(sammel(zaehler3)) And zaehler4(zaehler1) = 0 Then
.Cells(1, zaehler1).EntireColumn.Hidden = True
Else
.Cells(1, zaehler1).EntireColumn.Hidden = False
zaehler4(zaehler1) = 1
End If
Next zaehler3
Next zaehler1
End With
Application.EnableEvents = True
End Sub

hi gerd :-)

ups korrigiert :-))

gruss nighty

Option Explicit
Sub makro01()
Application.EnableEvents = False
Dim spaltende As Integer
Dim zaehler1 As Integer
Dim zaehler2 As Integer
Dim zaehler3 As Integer
Dim spalten As Integer
Dim EinGabe As String
ReDim sammel(1) As String
spalten = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column
ReDim zaehler4(spalten) As Boolean
With ActiveSheet
If .Range("B1:IV1").EntireColumn.Hidden = True Then
.Range("B1:IV1").EntireColumn.Hidden = False
End
End If
EinGabe = InputBox("Eingabe des Monats")
zaehler2 = 1
For zaehler1 = 1 To Len(EinGabe)
If Mid(EinGabe, zaehler1, 1) <> " " Then
sammel(zaehler2) = sammel(zaehler2) + Mid(EinGabe, zaehler1, 1)
Else
zaehler2 = zaehler2 + 1
ReDim Preserve sammel(zaehler2)
End If
Next zaehler1
.Range("B1:IV1").EntireColumn.Hidden = False
For zaehler1 = 2 To spalten
For zaehler3 = 1 To zaehler2
If UCase(Cells(1, zaehler1)) <> UCase(sammel(zaehler3)) And zaehler4(zaehler1) = 0 Then
.Cells(1, zaehler1).EntireColumn.Hidden = True
Else
.Cells(1, zaehler1).EntireColumn.Hidden = False
zaehler4(zaehler1) = 1
End If
Next zaehler3
Next zaehler1
End With
Application.EnableEvents = True
End Sub

hi all :-)

war noch immer ein fehler drin ,das einblenden geht nur spaltenweise nicht in einem rutsch :-)

gruss nighty

jetzt muesste aber :-))

Sub makro01()
Application.EnableEvents = False
Dim spaltende As Integer
Dim zaehler1 As Integer
Dim zaehler2 As Integer
Dim zaehler3 As Integer
Dim zaehler5 As Integer
Dim spalten As Integer
Dim EinGabe As String
ReDim sammel(1) As String
spalten = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column
ReDim zaehler4(spalten) As Boolean
With ActiveSheet
For zaehler1 = 1 To 255
If .Cells(1, zaehler1).EntireColumn.Hidden = True Then
.Cells(1, zaehler1).EntireColumn.Hidden = False
zaehler5 = 1
End If
Next zaehler1
If zaehler5 = 1 Then End
EinGabe = InputBox("Eingabe des Monats")
zaehler2 = 1
For zaehler1 = 1 To Len(EinGabe)
If Mid(EinGabe, zaehler1, 1) <> " " Then
sammel(zaehler2) = sammel(zaehler2) + Mid(EinGabe, zaehler1, 1)
Else
zaehler2 = zaehler2 + 1
ReDim Preserve sammel(zaehler2)
End If
Next zaehler1
For zaehler1 = 2 To spalten
For zaehler3 = 1 To zaehler2
If UCase(Cells(1, zaehler1)) <> UCase(sammel(zaehler3)) And zaehler4(zaehler1) = 0 Then
.Cells(1, zaehler1).EntireColumn.Hidden = True
Else
.Cells(1, zaehler1).EntireColumn.Hidden = False
zaehler4(zaehler1) = 1
End If
Next zaehler3
Next zaehler1
End With
Application.EnableEvents = True
End Sub

Hallo nighty
Vielen Dank für deine Hilfe.
Ich kann leider mit den Daten in einem Makro nichts anfangen. Das sind für mich Bömische Wälder.

Zur Erklärung meiner Exceltabelle:

In der Spalte C4 - C~ stehen Namen. In den Spalten ab D4 - D~ stehen Daten, z.B. Apfel, in Spalte E4 - E~ stehen Birnen, in Spalte F4 - F~ stehen Melonen usw.

Nun kann es sein, dass die Person in C4 den Eintrag in D4 Apfel stehen hat, die Person in C5 hat keine weiteren Eintragungen in der entsprechenden Zeile. Die Person in C6 hat aber in D6 Apfel und in F6 Melone stehen.
Nun meine Idee: Die Spalten A - C und die Zeilen 1 - 3 sollen vom filtern ausgenommen werden.
Wenn ich jetzt alle Personen, die in dihrer Zeile ein Apfel stehen haben angezeigt haben will, sollen die anderen Zeilen und Spalten ausgeblendet werden.
Außerdem kann es sein, dass ich z.B. Apfel und Melone filtern möchte. Geht das und wie muß ich das eingeben.

Ich weiß. dass es eine chaotische Tabelle ist und wenn du noch Informationen brauchst, das kriege ich hin.


Vielen Dank für dein Bemühen
inselgerd

hi gerd :-)

schick eine mustertabelle mit beispiel an
oberley@t-online.de

mit aussagefaehigen betreff bitte :-))

gruss nighty

hi all :-)

und noch fuer die datenbank :-)

ein spalten verbundener zeilen filter

eingabe erlaubt soviele begriffe getrennt durch ein leerzeichen wie eine inputbox aufnehmen kann

gruss nighty

Option Explicit
Sub Filter()
Call EventsOff
Dim EinGabe As String
ReDim sammel(1) As String
Dim zeilen0 As Integer, zeilen1 As Long, zaehler1 As Integer, zaehler2 As Integer, zaehler3 As Integer, zaehler4 As Integer, zaehler6 As Integer
Dim spalten0 As Integer, spalten1 As Integer
Rem hier deinen filterbereich festlegen
Rem von bis
zeilen0 = 4
zeilen1 = 20
Rem von bis
spalten0 = 4
spalten1 = 9
With ActiveSheet
For zaehler1 = zeilen0 To zeilen1
.Rows(zaehler1 & ":" & zaehler1).EntireRow.Hidden = False
Next zaehler1
For zaehler1 = spalten0 To spalten1
.Cells(1, zaehler1).EntireColumn.Hidden = False
Next zaehler1
EinGabe = InputBox("Eingabe des Obstes")
If EinGabe = "" Then End
zaehler4 = 1
For zaehler1 = 1 To Len(EinGabe)
If Mid(EinGabe, zaehler1, 1) <> " " Then
sammel(zaehler4) = sammel(zaehler4) + Mid(EinGabe, zaehler1, 1)
Else
zaehler4 = zaehler4 + 1
ReDim Preserve sammel(zaehler4)
End If
Next zaehler1
For zaehler1 = zeilen0 To zeilen1
For zaehler2 = spalten0 To spalten1
For zaehler3 = 1 To zaehler4
If UCase(Cells(zaehler1, zaehler2)) = UCase(sammel(zaehler3)) Then
zaehler6 = zaehler6 + 1
End If
Next zaehler3
Next zaehler2
If zaehler6 = 0 Then
.Rows(zaehler1 & ":" & zaehler1).EntireRow.Hidden = True
Else
zaehler6 = 0
End If
Next zaehler1
zaehler6 = 0
For zaehler1 = spalten0 To spalten1
For zaehler2 = zeilen0 To zeilen1
For zaehler3 = 1 To zaehler4
If UCase(Cells(zaehler2, zaehler1)) = UCase(sammel(zaehler3)) Then
zaehler6 = zaehler6 + 1
End If
Next zaehler3
Next zaehler2
If zaehler6 = 0 Then
.Cells(1, zaehler1).EntireColumn.Hidden = True
Else
zaehler6 = 0
End If
Next zaehler1
End With
Call EventsOn
End Sub
Public Sub EventsOn()
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub
Public Sub EventsOff()
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
End Sub