Doppelte suchen und zählen!

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox
Bild

Betrifft: Doppelte suchen und zählen!
von: Markus
Geschrieben am: 06.04.2005 18:37:21
Hallo Leute ,
ich habe folgendes Problem und bräuchte mal eure Hilfe.
Ich möchte Zeilen von E bis K kontrollieren welche eine Rote Schrift haben und nicht Doppelt sind (Text und Zahlen).
Also z.B in der Spalte E steht in roter Schrift Hans in Spalte F in roter Schrift Michael und in Spalte H in Roter Schrift Hans.(einige Zellen dazwischen können leer sein)
Somit gibt es 3 Zellen in roter Schrift wobei aber Hans doppelt (kann auch teilweise 3 oder 4 mal sein) vorkommt.
Mein Ergebnis müsste also 2 lauten (rote Schrift Hans und rote Schrift Michael, da Hans doppelt war.
Gibt es eine Lösung für diese Spezielle Sache. Ich habe viele Zeilen zu kontrollieren.
Ich hoffe die Experten hier haben eine Lösung
Danke Euch schon mal vielmals
Gruß
Markus

Bild

Betrifft: AW: Doppelte suchen und zählen!
von: Ceyser Soze
Geschrieben am: 06.04.2005 20:06:08
Hi Markus,
der Code hier durchsucht die spalten E-K (kann etwas dauern) und gibt eine Meldung aus. Das betreffende Blatt muss aktiviert sein, wenn der Code ausgeführt wird.


      
Sub rote_finden()
Dim Zelle As Range
Dim rngSuche As Range
Dim Doppelt As Boolean
Dim colGefunden As New Collection
Dim i As Long, intZähler As Long
Set rngSuche = ActiveSheet.Range("E:K")
For Each Zelle In rngSuche
    
If Zelle.Font.ColorIndex = 3 Then
        Doppelt = 
False
        
For i = 1 To colGefunden.Count
            
If Zelle.Value = colGefunden(i) Then
                Doppelt = 
True
            
End If
        
Next i
        
If Doppelt = False Then
            colGefunden.Add Zelle.Value
        
End If
    
End If
Next Zelle
MsgBox "Anzahl roter Texte: " & colGefunden.Count
End Sub 

     Code eingefügt mit Syntaxhighlighter 3.0

Ist mit Sicherheit nicht die eleganteste Lösung. Aber es funktioniert. Es gibt bestimmt noch eine Möglichkeit mit der Find-Methode, aber ich habe keine Ahnung wie man mit dieser nach der Schriftfarbe suche kann. Das wäre bestimmt schneller.
Gruß
CS
Bild

Betrifft: Noch etwas zum ändern
von: markus
Geschrieben am: 07.04.2005 11:24:22
Hallo liebe Excel Spezialisten,
das obenstehende Macro funktioniert soweit prima. Ich bräuchte nur noch folgende Änderung. Also Ich durchsuche in der Tabelle1 den Bereich E100:K200 Zeile für Zeile. Jetzt soll in der Tabelle2 angezeigt werden wie oft mein Suchkriterium erfüllt wurde.
Also folgendes Beispiel.
In der Zeile 110 sind 3 rote Zellen also soll in der Zeile 110 in der Tabelle2 eine 3 stehen. In der Zeile 120 sind 5 rote Zellen also soll in der Zeile 120 der Tabelle2 eine 5 stehen.
Es soll also beim Ende des durchsuchens jeder Zeile der Wert in die Entsprechende Zeile der Tabelle2 geschrieben werden.
Habt Ihr eine Idee wie ich das umändern kann??

Danke und
Gruß Markus
Bild

Betrifft: AW: Noch etwas zum ändern
von: Ceyser Soze
Geschrieben am: 07.04.2005 16:53:50
Hi Markus,
so...


      
Sub rote_finden()
Dim Zelle As Range
Dim rngSuche As Range
Dim colGefunden As New Collection
Dim i As Long, j As Long
Dim anzRote%
Dim Doppelt As Boolean
Set rngSuche = Sheets(1).Range("E100:K200")
j = 1
For Each Zelle In rngSuche
    
If Zelle.Font.ColorIndex = 3 Then
        anzRote = anzRote + 1
        Doppelt = 
False
        
For i = 1 To colGefunden.Count
            
If Zelle.Value = colGefunden(i) Then
                Doppelt = 
True
            
End If
        
Next i
        
If Doppelt = False Then
            colGefunden.Add Zelle.Value
        
End If
    
End If
    
If j Mod 7 = 0 Then
        
'Am Ende jeder Zeile wird die Anzahl roter Zellen in Spalte A
        ' von Tabelle2 geschrieben
        Sheets(2).Cells(Zelle.Row, 1) = anzRote
        anzRote = 0
    
End If
    j = j + 1
Next Zelle
MsgBox "Anzahl roter Texte: " & colGefunden.Count
End Sub 

     Code eingefügt mit Syntaxhighlighter 3.0


Gruß
CS
Bild

Betrifft: Danke das ist genau das was ich brauche!!!
von: markus
Geschrieben am: 08.04.2005 13:37:36
Servus,
vielen Dank für dieses Spitzenprogramm war genau das was ich gesucht habe.

Prima was Ihr hier so drauf habt.
Danke noch mal und eine schönes Wochenende auch bei dem Wetter

Gruß Markus
 Bild

Beiträge aus den Excel-Beispielen zum Thema "Doppelte suchen und zählen!"