Suchen von nicht durchgestrichenen Wörtern in einer Arbeitsmappe

[Klaus-Dieter]

Hallo,

da stellt sich (wieder einmal) die Frage: warum werden Daten, die offenbar zusammen gehören, auf verschiedenen Tabellenblättern gehalten?

Das Makro kann man mit einer Schleife so umbauen, das es der Reihe nach die einzelnen Seiten abarbeitet. Besser wäre es aber die Struktur der Datei in Ordnung zu bringen.

[schauan]

Hallo Franziose,

also, ich würde den Code erst mal in ein Modul auslagern, also dann z.B.

Code:

Public Sub ZaehleMich()
    Dim RNG As Range, Zelle As Variant, Anz As Integer, Arr
    Dim i As Integer, A As Integer, E As Integer
    Dim strSuche As String 'ersetzt Target

        Set RNG = Range("B2:D100") 'Daten stehen hier
        If WorksheetFunction.CountA(RNG) = 0 Then
            MsgBox "Keine Texte gefunden"
            Exit Sub
        End If
        For Each Zelle In RNG.SpecialCells(xlCellTypeConstants, 3) 'nur Zellen mit Inhalt
            If InStr(Zelle, Trim(strSuche)) > 0 Then 'Ist Wort in Zelle?
                 Arr = Split(Zelle, " ")
                 For i = LBound(Arr) To UBound(Arr)
                     If Trim(Arr(i)) = Trim(strSuche) Then 'Ist Teilstring = Suchwort
                         A = InStr(Zelle, Arr(i)) 'Start
                         E = Len(Arr(i)) 'Länge des Wortes
                         If Arr(i) <> "" And Zelle.Characters(Start:=A, Length:=E).Font.Strikethrough = False Then
                             Anz = Anz + 1 'Zählen
                         End If
                     End If
                 Next
            End If
        Next
        MsgBox Anz & "x '" & strSuche  & "' NICHTdurchgestrichen gefunden"
End Sub

Im Tabellenblatt hättest Du dann nur noch

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("A1")) Is Nothing Then
        Call ZaehleMich
    End If
End Sub

Wenn Du mehrere Blätter hast und in jedes das Worksheet_Change einfügst, würde in jedem gesondert gezählt, wenn Du im jeweiligen Blatt in A1 was änderst.
Willst Du nur auf einem Blatt das Suchwort eintragen und mehrere durchsuchen, dann reicht Worksheet_Change in dem einen Blatt und ansonsten müssten mal einfach beschrieben z.B. bei ZaehleMich die Blätter definiert und in einer Schleife durchlaufen werden.
Das reagiert übrigens nicht, wenn jemand irgendwo Dein Suchwort nach der Zählung durchstreicht.

[Franziose]

So ich hab jetzt mal ne Beispieldatei gemacht einfach nur mit irgend welchen Namen als Beispiel


Im Tabellenblatt eins oben die Gelbe Zelle, wenn ich da ein Wort rein schreibe, dann sollen in allen Tabellenblättern dieser Datei dieses Wort, was nicht durchgestrichen ist, die Anzahl gefunden werden

Sorry mit den Codes da, das weiß ich nicht richtig wo das hin kommt.. Zumindest sind meine Versuche gescheitert.

Gruß

[UweD]

Ich nochmal

Wenn es mehrere Blätter sind..

Ich bin davon ausgegangen, dass du in einem Blatt das Suchwort einträgst und in allen Anderen dann zählen möchtest

Der Code steht weiterhin im Tabellenblatt, wo der Suchbegriff eingetragen wird, und durchläuft dann alle anderen Blätter

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Blatt As Worksheet, Bereich As String, RNG As Range, Zelle As Variant
    Dim Anz As Integer, Arr, i As Integer, A As Integer, E As Integer
   
    If Not Intersect(Target, Range("A1")) Is Nothing Then
        Bereich = "B2:D100"
       
        For Each Blatt In ThisWorkbook.Sheets
            Select Case Blatt.Name
                Case "Tabelle1"
                    'mach nix
                Case Else
                    Set RNG = Blatt.Range(Bereich) 'Daten stehen hier
                    If WorksheetFunction.CountA(RNG) > 0 Then
                        For Each Zelle In RNG.SpecialCells(xlCellTypeConstants, 3) 'nur Zellen mit Inhalt
                            If InStr(Zelle, Trim(Target)) > 0 Then 'Ist Wort in Zelle?
                                 Arr = Split(Zelle, " ")
                                 For i = LBound(Arr) To UBound(Arr)
                                     If Trim(Arr(i)) = Trim(Target) Then 'Ist Teilstring = Suchwort
                                         A = InStr(Zelle, Arr(i)) 'Start
                                         E = Len(Arr(i)) 'Länge des Wortes
                                         If Arr(i) <> "" And Zelle.Characters(Start:=A, Length:=E).Font.Strikethrough = False Then
                                             Anz = Anz + 1 'Zählen
                                         End If
                                     End If
                                 Next
                            End If
                        Next
                    End If
            End Select
        Next
        MsgBox Anz & "x '" & Target & "' NICHTdurchgestrichen gefunden"
    End If
End Sub

Sind weitere Blätter dabei, die unbetrachtet werden sollen, dann kannst du die so ergänzen

Code:

                Case "Tabelle1", "Dieses auch Nicht", "Müll"

Ist auch das Erste dabei, nimm alles mit Select und Case raus

LG UweD

[slowboarder]

Hi
wenn du die ganze Zelle durchgestrichen hast (so ist es zumindest in der Beispieldatei), dann kannst du auch die Menüfunktion SUCHEN von Excel verwenden.

- zum suchen über mehrere Tabellenblätter stellst du die Option "Durchsuchen" auf "Arbeitsmappe"
- um durchgestrichene Zellen auszuschließen klickst du oben rechts auf das DropDown "Format"
hier kannst du einstellungen, dass bestimmte Formate gesucht werden (auch in Kombination mit dem Wert)
du kannst das Format aus einer Zelle, die entsprechend formatiert ist, übernehmen (Format von Zelle wählen), oder die einzelnen Formate einstellen. Dabei gibt es für die Ausfahlfelder immer drei Optionen :
- Leer: Einstellung egal
- Minus: dieses Format wird nicht angewendet
- Haken: dieses Format muss angewendet werden.

somit kannst du dann durchgestrichene Zellen von der Suche ausschließen.

aber wie gesagt, das geht nur wenn die ganze Zelle durchgestrichen ist.
Sind nur Teile des Zellinhalts durchgestrichen, dann muss es per VBA programmiert werden.

Gruß Daniel

[UweD]

Angepasst auf deine Musterdatei.

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Blatt As Worksheet, Bereich As String, RNG As Range, Zelle As Variant
    Dim Anz As Integer, Arr, i As Integer, A As Integer, E As Integer
   
    If Not Intersect(Target, Range("A1")) Is Nothing Then
        Bereich = "B2:M100"
       
        For Each Blatt In ThisWorkbook.Sheets
            Set RNG = Blatt.Range(Bereich) 'Daten stehen hier
            If WorksheetFunction.CountA(RNG) > 0 Then
                For Each Zelle In RNG.SpecialCells(xlCellTypeConstants, 3) 'nur Zellen mit Inhalt
                    If InStr(Zelle, Trim(Target)) > 0 Then 'Ist Wort in Zelle?
                         Arr = Split(Zelle, " ")
                         For i = LBound(Arr) To UBound(Arr)
                             If Trim(Arr(i)) = Trim(Target) Then 'Ist Teilstring = Suchwort
                                 A = InStr(Zelle, Arr(i)) 'Start
                                 E = Len(Arr(i)) 'Länge des Wortes
                                 If Arr(i) <> "" And Zelle.Characters(Start:=A, Length:=E).Font.Strikethrough = False Then
                                     Anz = Anz + 1 'Zählen
                                 End If
                             End If
                         Next
                    End If
                Next
            End If
        Next
        MsgBox Anz & "x '" & Target & "' NICHTdurchgestrichen gefunden"
    End If
End Sub

LG UweD

[Gast 123]

Hallo

anbei eine einfache Beispieldatei von mir.  In A1 bitte mal Jeans oder Katja eingeben und schauen was passiert.

Die Makros der Kollegen sind qualitativ besser, aber ich glaube das du damit vielleicht nicht zurechtkommst.
Mein Makro prüft nur, ob die -ganze Zelle- durchgestrichen ist, so wie in deinem Beispiel vorgegeben.
Wennn es deinen Wünschen entspricht, findest du das Makro im Sheet Tabelle1.
Von dort kannst du es in deine Originaldatei kopieren.  Viel Spass beim testen.


mfg Gast 123