Suchen Zeilenweise!

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

Betrifft: Suchen Zeilenweise! von: markus
Geschrieben am: 11.04.2005 14:44:49

Hallo zusammen,

ich habe folgendes Problem. Das nachfolgende Programm durchsucht einen Bereich nach der Schriftfarbe Rot und zählt alle Zellen, welche eine Rote Schriftfarbe haben und nicht doppelt sind.
Nun bräuchte ich folgende Änderung. Ich möchte nur die doppelten Zellen in einer Zeile berücksichtigen nicht in dem kompletten Suchbereich.
Soll heißen in der Zeile 50 gibt es zwei Zellen mit roter Schrift die gleich sind z.B. (Hans / rote Schrift). Also soll nur eine 1 gezählt werden. Wenn jetzt aber Hans in der Zeile 50 und 51 steht soll eine 1 für die Zeile 50 und eine 1 für die Zeile 51 gezählt werden. Gibt es eine Möglichkeit diesen VBA Code so zu ändern, dass nur die doppelten Zeilenweise und nicht Bereichsweise kontrolliert werden.

Sub Rote_Finden()
'
Application.ScreenUpdating = False
'Sheets("Tabelle1").Activate
  Dim Anfang As Long
  Dim Ende As Long
  Anfang = Range("AA2") ' Zeile des Aktuellen Datums
  Ende = Range("AC2")   ' Datum plus Anzahl Tage in der Zukunft
Sheets("Belegungsplan").Activate
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 = ActiveSheet.Range("E161:K300")
'
Set rngSuche = ActiveSheet.Range("E" & Anfang & ":K" & Ende)
j = 1
For Each Zelle In rngSuche
    If Not IsEmpty(Zelle) And Zelle.Font.ColorIndex = 3 Or Zelle.Font.ColorIndex = 10 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
            anzRote = anzRote + 1
            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("Belegungsplan").Cells(Zelle.Row, 27) = anzRote
        Sheets("Belegungsplan").Cells(Zelle.Row, 28) = anzRote
        anzRote = 0
    End If
    j = j + 1
Next Zelle
 Sheets("Belegungsplan").Activate
 Application.ScreenUpdating = True
 'MsgBox "Anzahl roter Texte: " & colGefunden.Count
End Sub



Hoffe Ihr habt eine Idee


Danke Euch

Gruß Markus
Bild


Betrifft: Doch nicht zu knacken?? von: markus
Geschrieben am: 12.04.2005 10:12:05

Hallo und guten morgen zusammen,

hat den keiner eine Idee wie ich die Doppelten nur Zeilenweise kontrolliere. Oder ist es so blöd geschrieben das man es nicht verstehen kann ??? Dann versuche ich es noch mal anderst.


Hoffe euch fällt noch was ein


Gruß Markus


 Bild

Beiträge aus den Excel-Beispielen zum Thema "Suchen Zeilenweise!"