EXCEL 2003 Suchfeld (2)

Dieses Thema EXCEL 2003 Suchfeld (2) im Forum "Microsoft Office Suite" wurde erstellt von Christian Gebbe, 19. Juni 2007.

Thema: EXCEL 2003 Suchfeld (2) Hallo liebe Community, ich habe die Seite über die googlesuche gefunden, da ich eine Liste mit Suchfeld in Excel...

  1. Hallo liebe Community,

    ich habe die Seite über die googlesuche gefunden, da ich eine Liste mit Suchfeld in Excel kreiren möchte. Dabei bin ich auf diese Seite gestoßen:

    http://www.wintotal-forum.de/index....f7fc89c915e0657a91f7905&topic=91493.0;all


    Das Skript klappt ganz wunderbar, allerdings liefert es bei mehreren Suchbegriffen mehr anstatt weniger Ergebnisse (also additive statt subtraktive Suche). Ich bin selber kein Excel Programmierer, habe mir aber den Code angeguckt und verstanden wieso.

    Kann man dass Skript so umschreiben, dass es bei mehreren Suchbegriffen die Suche eingrenzt? Theoretisch wären meine Ideen gewesen, dass entweder die gefundenen Reihen so oft gefunden werden müssen wie es Suchbegriffe gibt;
    oder dass man nicht die Zellen findet, die den Suchbegriff enthalten, sondern die, die den Suchbegriff NICHT enthalten, und bei der Ergebnisdarstellung dann erst alle einblendet und anschließend die gefunden Reihen ausblendet. Ich habe auch probiert dies umzusetzen, bin aber einfach zu wenig mit Excel vertraut.

    Ich hoffe ihr könnt mir helfen, hier nochmal der Code von Matjes (ich hoffe du guckst hier rein) und schon ein mal vielen Dank im voraus!

    Christian


    Code:
    Option Explicit
     Type MySuchbegriffe_structure
      s_Suchbegriff As String
      l_Spalte As Long
      z_cnt As Long
      z() As Long
     End Type
     
    '#### A N P A S S E N ###############
    ->Definitionen der Suchfelder
     Public Const c_SUCHZEILE = 2
     Public Const c_SUCHSPALTE_AB = 1->entspricht Spalte A
     Public Const c_SUCHSPALTE_BIS = 5->entspricht Spalte E
     
    ->erste Zeile mit Adressdaten
     Public Const c_ERSTEWERTEZEILE = 4
    '#### A N P A S S E N ###############
     
     Public ws As Worksheet
    '*****************************************************************
    Function ZeilenMitSuchbegriffenAnzeigen( _
                 ws As Worksheet, _
                 f() As MySuchbegriffe_structure, _
                 f_cnt As Long)
     
     Dim l_ZeileMax As Long, x As Long, z As Long
     
    ->erstmal alle Zeilen ausblenden
     l_ZeileMax = ws.UsedRange.Row + ws.UsedRange.Rows.Count - 1
     ws.Rows(c_ERSTEWERTEZEILE & : & l_ZeileMax).Hidden = True
     
    ->gemerkte Zeilen mit Fundort einblenden
     For x = 1 To f_cnt: For z = 1 To f(x).z_cnt: ws.Rows(f(x).z(z)).Hidden = False: Next z: Next x
    
    End Function
    '*****************************************************************
    Function SuchbegriffeFeststellen( _
                 ws As Worksheet, _
                 f() As MySuchbegriffe_structure, _
                 f_cnt As Long)
     
     Dim s_Suchbegriff As String, c As Long
    
    ->Alle Suchbegriffe feststellen
     f_cnt = 0: ReDim f(1 To 1)
     For c = c_SUCHSPALTE_AB To c_SUCHSPALTE_BIS
      s_Suchbegriff = Trim(ws.Cells(c_SUCHZEILE, c).Value)
     ->Suchbegriff nicht leer ?
      If s_Suchbegriff <>  Then
      ->Suchbegriff und Spalte merken
       f_cnt = f_cnt + 1: ReDim Preserve f(1 To f_cnt)
       With f(f_cnt)
        .s_Suchbegriff = s_Suchbegriff
        .l_Spalte = c
       ->Zeilenmerker initialisieren
        .z_cnt = 0: ReDim .z(1 To 1)
       End With
      End If
     Next
    
    End Function
    
    '*****************************************************************
    Function ZeilenMitSuchbegriffSuchen( _
                 ws As Worksheet, _
                 f() As MySuchbegriffe_structure, _
                 f_cnt As Long) As Boolean
       
     Dim r As Range, Zelle As Range
     Dim l_ZeileMax As Long, s_ersteAdresse As String, x As Long
     Dim b_MindestensEineZeileRelevant As Boolean
     
     b_MindestensEineZeileRelevant = False
    
    ->Zeilen mit Suchbegriff suchen
     l_ZeileMax = ws.UsedRange.Row + ws.UsedRange.Rows.Count - 1
    ->für alle Suchbegriffe
     For x = 1 To f_cnt
      With f(x)
       Set r = ws.Range( _
             ws.Cells(c_ERSTEWERTEZEILE, .l_Spalte), _
             ws.Cells(l_ZeileMax, .l_Spalte))
       Set Zelle = r.Find( _
              What:=.s_Suchbegriff, _
              After:=ws.Cells(l_ZeileMax, .l_Spalte), _
              LookIn:=xlValues, _
              lookat:=xlPart)
       If Not Zelle Is Nothing Then
        s_ersteAdresse = Zelle.Address
        Do
        ->Zeile zum Suchbegriff merken
         .z_cnt = .z_cnt + 1: ReDim Preserve .z(1 To .z_cnt)
         .z(.z_cnt) = Zelle.Row
        ->Rückgabekennung setzen
         b_MindestensEineZeileRelevant = True
        ->nächsten Fundort suchen
         Set Zelle = r.FindNext(Zelle)
        Loop While Not Zelle Is Nothing And Zelle.Address <> s_ersteAdresse
       End If
      End With
     Next
    
     Set r = Nothing: Set Zelle = Nothing
    
     ZeilenMitSuchbegriffSuchen = b_MindestensEineZeileRelevant
    End Function

    Code:
    Option Explicit
    Private Sub Worksheet_Change(ByVal Target As Excel.Range)
     
     
     Dim f_Suchbegriff() As MySuchbegriffe_structure, f_Suchbegriff_cnt As Long
     Dim s_Blattname As String, ws as Worksheet
     
     s_Blattname = Target.Parent.Name
     Set ws = Worksheets(s_Blattname)
     
    ->Ist etwas in der Suchzeile geändert worden ?
     If Target.Rows.Count = 1 And Target.Row = c_SUCHZEILE Then
     ->Sind die Spalten der Suchfelder betroffen ?
      If Target.Column >= c_SUCHSPALTE_AB And Target.Column <= c_SUCHSPALTE_BIS Then
      
      ->Bildschirmupdate abschalten
       Application.ScreenUpdating = False
       
      ->erstmal alle Zeilen einblenden
       Cells.EntireRow.Hidden = False
       
      ->vorhandene Suchbegriffe feststellen
       Call SuchbegriffeFeststellen(ws, f_Suchbegriff, f_Suchbegriff_cnt)
       
      ->kein Suchbegriff vorhanden -> ENDE
       If f_Suchbegriff_cnt = 0 Then GoTo AUFRAEUMEN
       
      ->Zeilen mit Suchbegriff suchen
       If ZeilenMitSuchbegriffSuchen(ws, f_Suchbegriff, f_Suchbegriff_cnt) Then
        
       ->mindestens Suchbegriff in einer Zeile gefunden
       ->gemerkte Zeilen mit Fundort einblenden
        Call ZeilenMitSuchbegriffenAnzeigen(ws, f_Suchbegriff, f_Suchbegriff_cnt)
        
       Else
       ->keinen Suchbegriff in einer Zeile gefunden
       ->--> alle Zeilen eingeblendet lassen
       End If
      End If
     End If
     
    AUFRAEUMEN:
     Set ws = Nothing
    ->Bildschirmupdate anschalten
     Application.ScreenUpdating = True
    End Sub
     
  2. Hallo Christian,

    ich hab die unter ANPASSEN einen Schalter (Boolean) eingebaut, mit dem der additive Betrieb abgeschaltet werden kann ( und jetzt abgeschaltet ist).
    Die Function ZeilenMitSuchbegriffenAnzeigen wird jetzt mit dieser Steuervariablen aufgerufen und gibt die Zeilen entweder additiv oder subtraktiv aus.

    Gruß Matjes :)
    Code:
    Option Explicit
     Type MySuchbegriffe_structure
      s_Suchbegriff As String
      l_Spalte As Long
      z_cnt As Long
      z() As Long
     End Type
     
    '#### A N P A S S E N ###############
    ->Definitionen der Suchfelder
     Public Const c_SUCHZEILE = 2
     Public Const c_SUCHSPALTE_AB = 1->entspricht Spalte A
     Public Const c_SUCHSPALTE_BIS = 5->entspricht Spalte E
     
    ->erste Zeile mit Adressdaten
     Public Const c_ERSTEWERTEZEILE = 4
      
     Public Const cAdditiv = False  ->Art der Behandlung zusätlichen Filter
                     ->- true: Zeilen aller Filter darstellen
                     ->- false: Zeilen darstellen, die in allen Filtern vorhanden sind
    '#### A N P A S S E N ###############
     
     Public ws As Worksheet
    '*****************************************************************
    Function ZeilenMitSuchbegriffenAnzeigen( _
                 ws As Worksheet, _
                 f() As MySuchbegriffe_structure, _
                 f_cnt As Long, _
                 bAdditiv As Boolean)
     
     Dim l_ZeileMax As Long, x As Long, z As Long, m As Long, n As Long
     Dim fZ(), fZCnt As Long, lZeile As Long
     Dim bFound As Boolean
     
     
     ReDim fZ(1 To f(1).z_cnt)
     If f_cnt <= 0 Then Exit Function
     If bAdditiv Then
     ->erstmal alle Zeilen ausblenden
      l_ZeileMax = ws.UsedRange.Row + ws.UsedRange.Rows.Count - 1
      ws.Rows(c_ERSTEWERTEZEILE & : & l_ZeileMax).Hidden = True
      
     ->gemerkte Zeilen mit Fundort einblenden - additiv
      For x = 1 To f_cnt: For z = 1 To f(x).z_cnt: ws.Rows(f(x).z(z)).Hidden = False: Next z: Next x
     
     Else
     ->gemerkte Zeilen mit Fundort einblenden - subtraktiv
      ReDim fZ(1 To f(1).z_cnt)
      fZCnt = f(1).z_cnt
      
     ->Zeilennummern des 1.Filters laden
      For z = 1 To f(1).z_cnt: fZ(z) = f(1).z(z): Next
      
     ->Über alle anderen filter
      For x = 2 To f_cnt
       For z = fZCnt To 1 Step -1
        lZeile = fZ(z)
       ->in Filter suchen
        bFound = False
        For n = 1 To f(x).z_cnt
         If lZeile = f(x).z(n) Then bFound = True: Exit For
        Next
        If Not bFound Then
        ->Zeilennummer aus List löschen
         For m = z To fZCnt - 1: fZ(m) = fZ(m + 1): Next
         fZCnt = fZCnt - 1
        End If
       Next
      Next
      
      l_ZeileMax = ws.UsedRange.Row + ws.UsedRange.Rows.Count - 1
      If fZCnt = 0 Then
       ws.Rows(c_ERSTEWERTEZEILE & : & l_ZeileMax).Hidden = False
      Else
       ws.Rows(c_ERSTEWERTEZEILE & : & l_ZeileMax).Hidden = True
       For x = 1 To fZCnt: ws.Rows(fZ(x)).Hidden = False: Next
      End If
     
     End If
     
    End Function
    '*****************************************************************
    Function SuchbegriffeFeststellen( _
                 ws As Worksheet, _
                 f() As MySuchbegriffe_structure, _
                 f_cnt As Long)
     
     Dim s_Suchbegriff As String, c As Long
    
    ->Alle Suchbegriffe feststellen
     f_cnt = 0: ReDim f(1 To 1)
     For c = c_SUCHSPALTE_AB To c_SUCHSPALTE_BIS
      s_Suchbegriff = Trim(ws.Cells(c_SUCHZEILE, c).Value)
     ->Suchbegriff nicht leer ?
      If s_Suchbegriff <>  Then
      ->Suchbegriff und Spalte merken
       f_cnt = f_cnt + 1: ReDim Preserve f(1 To f_cnt)
       With f(f_cnt)
        .s_Suchbegriff = s_Suchbegriff
        .l_Spalte = c
       ->Zeilenmerker initialisieren
        .z_cnt = 0: ReDim .z(1 To 1)
       End With
      End If
     Next
    
    End Function
    
    '*****************************************************************
    Function ZeilenMitSuchbegriffSuchen( _
                 ws As Worksheet, _
                 f() As MySuchbegriffe_structure, _
                 f_cnt As Long) As Boolean
       
     Dim r As Range, Zelle As Range
     Dim l_ZeileMax As Long, s_ersteAdresse As String, x As Long
     Dim b_MindestensEineZeileRelevant As Boolean
     
     b_MindestensEineZeileRelevant = False
    
    ->Zeilen mit Suchbegriff suchen
     l_ZeileMax = ws.UsedRange.Row + ws.UsedRange.Rows.Count - 1
    ->für alle Suchbegriffe
     For x = 1 To f_cnt
      With f(x)
       Set r = ws.Range( _
             ws.Cells(c_ERSTEWERTEZEILE, .l_Spalte), _
             ws.Cells(l_ZeileMax, .l_Spalte))
       Set Zelle = r.Find( _
              What:=.s_Suchbegriff, _
              After:=ws.Cells(l_ZeileMax, .l_Spalte), _
              LookIn:=xlValues, _
              lookat:=xlPart)
       If Not Zelle Is Nothing Then
        s_ersteAdresse = Zelle.Address
        Do
        ->Zeile zum Suchbegriff merken
         .z_cnt = .z_cnt + 1: ReDim Preserve .z(1 To .z_cnt)
         .z(.z_cnt) = Zelle.Row
        ->Rückgabekennung setzen
         b_MindestensEineZeileRelevant = True
        ->nächsten Fundort suchen
         Set Zelle = r.FindNext(Zelle)
        Loop While Not Zelle Is Nothing And Zelle.Address <> s_ersteAdresse
       End If
      End With
     Next
    
     Set r = Nothing: Set Zelle = Nothing
    
     ZeilenMitSuchbegriffSuchen = b_MindestensEineZeileRelevant
    End Function
    Code für die Tabellen-Seite:
    (muß natürlich für den neuen Aufruf-Parameter angepaßt werden)
    Code:
    Option Explicit
    Private Sub Worksheet_Change(ByVal Target As Excel.Range)
     
     
     Dim f_Suchbegriff() As MySuchbegriffe_structure, f_Suchbegriff_cnt As Long
     Dim s_Blattname As String, ws As Worksheet
     
     s_Blattname = Target.Parent.Name
     Set ws = Worksheets(s_Blattname)
     
    ->Ist etwas in der Suchzeile geändert worden ?
     If Target.Rows.Count = 1 And Target.Row = c_SUCHZEILE Then
     ->Sind die Spalten der Suchfelder betroffen ?
      If Target.Column >= c_SUCHSPALTE_AB And Target.Column <= c_SUCHSPALTE_BIS Then
      
      ->Bildschirmupdate abschalten
       Application.ScreenUpdating = False
       
      ->erstmal alle Zeilen einblenden
       Cells.EntireRow.Hidden = False
       
      ->vorhandene Suchbegriffe feststellen
       Call SuchbegriffeFeststellen(ws, f_Suchbegriff, f_Suchbegriff_cnt)
       
      ->kein Suchbegriff vorhanden -> ENDE
       If f_Suchbegriff_cnt = 0 Then GoTo AUFRAEUMEN
       
      ->Zeilen mit Suchbegriff suchen
       If ZeilenMitSuchbegriffSuchen(ws, f_Suchbegriff, f_Suchbegriff_cnt) Then
        
       ->mindestens Suchbegriff in einer Zeile gefunden
       ->gemerkte Zeilen mit Fundort einblenden
        Call ZeilenMitSuchbegriffenAnzeigen(ws, f_Suchbegriff, f_Suchbegriff_cnt, cAdditiv)
        
       Else
       ->keinen Suchbegriff in einer Zeile gefunden
       ->--> alle Zeilen eingeblendet lassen
       End If
      End If
     End If
     
    AUFRAEUMEN:
     Set ws = Nothing
    ->Bildschirmupdate anschalten
     Application.ScreenUpdating = True
    End Sub
     
  3. Hallo Christian,

    hier ist jetzt noch eine ganz flexible Variante:

    in Zelle A1 wird additiv dynamisch gesetzt:
    erstes Zeichen ist ein a -> additiv (Ausleuchtung grün)
    erstes Zeichen ist ein s -> subtraktiv (Ausleuchtung grün)
    (sonst Ausleuchtung Orange)

    in Zelle A2 wird invers dynamisch gesetzt:
    erstes Zeichen ist ein i -> invers (Ausleuchtung grün)
    erstes Zeichen ist ein Leerzeichen zw. leer -> normal (Ausleuchtung grün)
    (sonst Ausleuchtung Orange)


    Suchbegriffe in A2 -E2

    Korrespondierend dazu kann in A3 bis E3 ein n eingetregen werden, welches soviel wie Negativ bedeutet - als gefilterte Zeilen gelten alle Zeilen die bei positivem Filter ausgefiltern worden wären - also quasi Filter invers.

    Hast du noch weiter Wünsche ?

    Gruß Matjes :)

    Code für das Modul:
    Code:
    Option Explicit
     Type MySuchbegriffe_structure
      s_Suchbegriff As String
      l_Spalte As Long
      bPositiv As Boolean
      z_cnt As Long
      z() As Long
     End Type
     
    '#### A N P A S S E N ###############
    ->Definition der Einstellung additiv/subtraktiv
     Public Const c_EINST_ZEILE = 1
     Public Const c_EINST_SP_ADDITIV = 1
    ->Wenn Zelle A1 als erstes Zeichen ein a enthält -> additiv  (Ausleuchtung grün)
    ->Wenn Zelle A1 als erstes Zeichen ein s enthält -> subtraktiv (Ausleuchtung grün)
    ->(sonst Ausleuchtung Orange)
     Public Const c_EINST_SP_INVERS = 2
    ->Wenn Zelle A2 als erstes Zeichen ein Leerzeichen oder nichts enthält
    ->                        -> normal  (Ausleuchtung grün)
    ->Wenn Zelle A2 als erstes Zeichen ein i enthält -> invers  (Ausleuchtung grün)
    ->(invers: alle Zeilen, die in normal dargestellt werden, werden ausgeblendet
    -> und umgekehrt)
    ->(sonst Ausleuchtung Orange)
     
    ->Definitionen der Suchfelder
     Public Const c_SUCHZEILE = 2
     Public Const c_SUCHZEILEPLUSMINUS = 3->p oder nichts -> Positiv->n ->Negativ
     Public Const c_SUCHSPALTE_AB = 1->entspricht Spalte A
     Public Const c_SUCHSPALTE_BIS = 5->entspricht Spalte E
     
    ->erste Zeile mit Adressdaten
     Public Const c_ERSTEWERTEZEILE = 4
      
     Public Const cAdditiv = False   ->Art der Behandlung zusätlichen Filter
                      ->- true: Zeilen aller Filter darstellen
                      ->- false: Zeilen darstellen, die in allen Filtern vorhanden sind
    '#### A N P A S S E N ###############
     
     Public ws As Worksheet
    '*****************************************************************
    Function ZeilenMitSuchbegriffenAnzeigen( _
                 ws As Worksheet, _
                 f() As MySuchbegriffe_structure, _
                 f_cnt As Long, _
                 bAdditiv As Boolean, _
                 bInvers As Boolean)
     
     Dim l_ZeileMax As Long, x As Long, z As Long, m As Long, n As Long
     Dim fZ(), fZCnt As Long, lZeile As Long
     Dim bFound As Boolean
     
     If f_cnt <= 0 Then Exit Function
     If bAdditiv Then
     ->erstmal alle Zeilen ausblenden
      l_ZeileMax = ws.UsedRange.Row + ws.UsedRange.Rows.Count - 1
      ws.Rows(c_ERSTEWERTEZEILE & : & l_ZeileMax).Hidden = Not bInvers
      
     ->gemerkte Zeilen mit Fundort einblenden - additiv
      For x = 1 To f_cnt: For z = 1 To f(x).z_cnt: ws.Rows(f(x).z(z)).Hidden = bInvers: Next z: Next x
     
     Else
     ->gemerkte Zeilen mit Fundort einblenden - subtraktiv
      ReDim fZ(1 To f(1).z_cnt)
      fZCnt = f(1).z_cnt
      
     ->Zeilennummern des 1.Filters laden
      For z = 1 To f(1).z_cnt: fZ(z) = f(1).z(z): Next
      
     ->Über alle anderen filter
      For x = 2 To f_cnt
       For z = fZCnt To 1 Step -1
        lZeile = fZ(z)
       ->in Filter suchen
        bFound = False
        For n = 1 To f(x).z_cnt
         If lZeile = f(x).z(n) Then bFound = True: Exit For
        Next
        If Not bFound Then
        ->Zeilennummer aus List löschen
         For m = z To fZCnt - 1: fZ(m) = fZ(m + 1): Next
         fZCnt = fZCnt - 1
        End If
       Next
      Next
      
      l_ZeileMax = ws.UsedRange.Row + ws.UsedRange.Rows.Count - 1
      If fZCnt = 0 Then
       ws.Rows(c_ERSTEWERTEZEILE & : & l_ZeileMax).Hidden = bInvers
      Else
       ws.Rows(c_ERSTEWERTEZEILE & : & l_ZeileMax).Hidden = Not bInvers
       For x = 1 To fZCnt: ws.Rows(fZ(x)).Hidden = bInvers: Next
      End If
     
     End If
     
    End Function
    '*****************************************************************
    Function SuchbegriffeFeststellen( _
                 ws As Worksheet, _
                 f() As MySuchbegriffe_structure, _
                 f_cnt As Long) As Boolean
     
     Dim s_Suchbegriff As String, c As Long, bPositiv As Boolean, s As String
    
    ->Alle Suchbegriffe feststellen
     f_cnt = 0: ReDim f(1 To 5)
     For c = c_SUCHSPALTE_AB To c_SUCHSPALTE_BIS
      s_Suchbegriff = Trim(ws.Cells(c_SUCHZEILE, c).Value)
     ->Suchbegriff nicht leer ?
      If s_Suchbegriff <>  Then
       With ws.Cells(c_SUCHZEILEPLUSMINUS, c)
        s = .Value
        .Interior.ColorIndex = 35->hellgruen
       End With
       If s = p Or s =  Then
        bPositiv = True
       ElseIf s = n Then
        bPositiv = False
       Else
        With ws.Cells(c_SUCHZEILEPLUSMINUS, c)
         .Interior.ColorIndex = 40->hellorange
         Application.EnableEvents = False
         .Value = Fehler - p oder n oder leer
         Application.EnableEvents = True
        End With
        Exit Function
       End If
       
      ->Suchbegriff und Spalte merken
       If UBound(f()) >= f_cnt Then ReDim Preserve f(1 To f_cnt + 5)
       f_cnt = f_cnt + 1
       With f(f_cnt)
        .s_Suchbegriff = s_Suchbegriff
        .l_Spalte = c
        .bPositiv = bPositiv
       ->Zeilenmerker initialisieren
        .z_cnt = 0: ReDim .z(1 To 100)
       End With
      End If
     Next
    
     SuchbegriffeFeststellen = True
    End Function
    
    '*****************************************************************
    Function ZeilenMitSuchbegriffSuchen( _
                 ws As Worksheet, _
                 f() As MySuchbegriffe_structure, _
                 f_cnt As Long) As Boolean
       
     Dim r As Range, Zelle As Range
     Dim l_ZeileMax As Long, s_ersteAdresse As String, y As Long
     Dim b_MindestensEineZeileRelevant As Boolean
     Dim fx() As Long, fxCnt As Long, lZeile As Long, x As Long, m As Long
     
     b_MindestensEineZeileRelevant = False
    
    ->Zeilen mit Suchbegriff suchen
     l_ZeileMax = ws.UsedRange.Row + ws.UsedRange.Rows.Count - 1
    ->für alle Suchbegriffe
     For y = 1 To f_cnt
      With f(y)
       Set r = ws.Range( _
             ws.Cells(c_ERSTEWERTEZEILE, .l_Spalte), _
             ws.Cells(l_ZeileMax, .l_Spalte))
       Set Zelle = r.Find( _
              What:=.s_Suchbegriff, _
              After:=ws.Cells(l_ZeileMax, .l_Spalte), _
              LookIn:=xlValues, _
              lookat:=xlPart)
       fxCnt = 0: ReDim fx(1 To 100)
       If Not Zelle Is Nothing Then
        s_ersteAdresse = Zelle.Address
        Do
        ->Zeile zum Suchbegriff merken
         If UBound(fx()) >= fxCnt Then ReDim Preserve fx(1 To fxCnt + 100)
         fxCnt = fxCnt + 1
         fx(fxCnt) = Zelle.Row
        ->Rückgabekennung setzen
         b_MindestensEineZeileRelevant = True
        ->nächsten Fundort suchen
         Set Zelle = r.FindNext(Zelle)
        Loop While Not Zelle Is Nothing And Zelle.Address <> s_ersteAdresse
       End If
       
       If fxCnt > 0 Then
        If .bPositiv Then
         .z_cnt = fxCnt: ReDim .z(1 To .z_cnt)
         For x = 1 To .z_cnt: .z(x) = fx(x): Next
        Else
         .z_cnt = l_ZeileMax - c_ERSTEWERTEZEILE + 1 - fxCnt: ReDim .z(1 To .z_cnt)
         m = 1: .z_cnt = 0
         For x = c_ERSTEWERTEZEILE To l_ZeileMax
          If fx(m) = x Then
           m = m + 1
          Else
           .z_cnt = .z_cnt + 1
           .z(.z_cnt) = x
          End If
         Next
        End If
       Else
        If .bPositiv Then
         .z_cnt = 0: ReDim .z(1 To 1)
        Else
         .z_cnt = l_ZeileMax - c_ERSTEWERTEZEILE + 1: ReDim .z(1 To .z_cnt)
         lZeile = c_ERSTEWERTEZEILE
         For x = 1 To .z_cnt: .z(x) = lZeile: lZeile = lZeile + 1: Next
        End If
       End If
       
      End With
     Next
    
     Set r = Nothing: Set Zelle = Nothing
    
     ZeilenMitSuchbegriffSuchen = b_MindestensEineZeileRelevant
    End Function
    Code für das Tabellenblatt:
    Code:
    Option Explicit
    Private Sub Worksheet_Change(ByVal Target As Excel.Range)
     
     
     Dim f_Suchbegriff() As MySuchbegriffe_structure, f_Suchbegriff_cnt As Long
     Dim s_Blattname As String, s As String
     Dim bAdditiv As Boolean, bInvers As Boolean
     Dim ws As Worksheet
     
     s_Blattname = Target.Parent.Name
     Set ws = Worksheets(s_Blattname)
     
    ->Ist etwas in der Such- oder Einstellungs-Zeile geändert worden ?
     If Target.Rows.Count = 1 Then
      If (Target.Row = c_SUCHZEILE And _
        Target.Column >= c_SUCHSPALTE_AB And Target.Column <= c_SUCHSPALTE_BIS) _
       Or _
       (Target.Row = c_SUCHZEILEPLUSMINUS And _
        Target.Column >= c_SUCHSPALTE_AB And Target.Column <= c_SUCHSPALTE_BIS) _
       Or _
        (Target.Row = c_EINST_ZEILE And Target.Column = c_EINST_SP_ADDITIV) _
       Or _
        (Target.Row = c_EINST_ZEILE And Target.Column = c_EINST_SP_INVERS) Then
        
      ->Bildschirmupdate abschalten
       Application.ScreenUpdating = False
       
      ->Einstellung additiv / subtraktiv
       s = LCase(Left(ws.Cells(c_EINST_ZEILE, c_EINST_SP_ADDITIV).Value, 1))
       ws.Cells(c_EINST_ZEILE, c_EINST_SP_ADDITIV).Interior.ColorIndex = 35->hellgruen
       If s = a Then
        bAdditiv = True
       ElseIf s = s Then
        bAdditiv = False
       Else
        With ws.Cells(c_EINST_ZEILE, c_EINST_SP_ADDITIV)
         .Interior.ColorIndex = 40->hellorange
         Application.EnableEvents = False
         .Value = Fehler - s oder a
         Application.EnableEvents = True
        End With
       End If
       
      ->Einstellung normal / invers
       s = LCase(Left(ws.Cells(c_EINST_ZEILE, c_EINST_SP_INVERS).Value, 1))
       ws.Cells(c_EINST_ZEILE, c_EINST_SP_INVERS).Interior.ColorIndex = 35->hellgruen
       If s = i Then
        bInvers = True
       ElseIf s =  Or s =   Then
        bInvers = False
       Else
        With ws.Cells(c_EINST_ZEILE, c_EINST_SP_INVERS)
         .Interior.ColorIndex = 40->hellorange
         Application.EnableEvents = False
         .Value = Fehler - i oder leer
         Application.EnableEvents = True
        End With
       End If
       
      ->erstmal alle Zeilen einblenden
       Cells.EntireRow.Hidden = False
       
      ->vorhandene Suchbegriffe feststellen
       If Not SuchbegriffeFeststellen(ws, f_Suchbegriff, f_Suchbegriff_cnt) Then GoTo AUFRAEUMEN
       
      ->kein Suchbegriff vorhanden -> ENDE
       If f_Suchbegriff_cnt = 0 Then GoTo AUFRAEUMEN
       
      ->Zeilen mit Suchbegriff suchen
       If ZeilenMitSuchbegriffSuchen(ws, f_Suchbegriff, f_Suchbegriff_cnt) Then
        
       ->mindestens Suchbegriff in einer Zeile gefunden
       ->gemerkte Zeilen mit Fundort einblenden
        Call ZeilenMitSuchbegriffenAnzeigen( _
              ws, f_Suchbegriff, f_Suchbegriff_cnt, bAdditiv, bInvers)
        
       Else
       ->keinen Suchbegriff in einer Zeile gefunden
       ->--> alle Zeilen eingeblendet lassen
       End If
      End If
     End If
     
    AUFRAEUMEN:
     Set ws = Nothing
    ->Bildschirmupdate anschalten
     Application.ScreenUpdating = True
    End Sub
     
  4. Wow, du bist ein Schatz, es klappt perfekt!

    Vielen, vielen Dank :1
     
Die Seite wird geladen...

EXCEL 2003 Suchfeld (2) - Ähnliche Themen

Forum Datum
Excel 2003 - Kleines Problem mit einer Formel Microsoft Office Suite 25. Juni 2014
Office 2003 und 2010 Paralellinstallatin, mehrer xls-Dateien Excel 2003 zuweisen Windows XP Forum 13. Juli 2012
2 Spalten in Excel 2003 fixieren Microsoft Office Suite 28. Mai 2012
MS Excel 2003 ganze Zeilen löschen Microsoft Office Suite 1. Okt. 2011
Verlinkung nach Umstieg Excel 2003 auf 2007 Microsoft Office Suite 23. Mai 2011