Speicher löschen!

Hallo Freunde,
wo wird denn in diesem Code der Suchbegegriff abgelegt. Ich möchte nach jeder Zeile die "alten" bzw. gemerkten Suchbegriffe wieder löschen um jede Zeile einzeln zu behandeln. Aktuell merkt sich das Programm alle Suchbegriffe und erkennt alle Doppelten im Suchbereich.
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 'And Not (Cells(Zelle.Row) = t) Then
Doppelt = True ' Doppelte gefunden
'MsgBox ("Doppelt : " & Zelle.Value & "Zeile :" & t)
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 die entsprechende
'Spalte von Tabelle2 geschrieben
Sheets("Belegungsplan").Cells(Zelle.Row, 27) = anzRote ' Spalte AA
Sheets("Belegungsplan").Cells(Zelle.Row, 28) = anzRote ' Spalte AB
anzRote = 0
'

'Cells(Zelle.Row) = t
t = t + 1
End If
j = j + 1
Next Zelle
Sheets("Belegungsplan").Activate
Application.ScreenUpdating = True
'MsgBox "Anzahl roter Texte: " & colGefunden.Count
End Sub
Ich hoffe Ihr könnt mir weiterhelfen
Danke Gruß
markus

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo und gutn morgen,
witer unten folgendes Programm. Dieses Programm durchsucht einen bestimmten Bereich nach Zellen die eine Rote Schriftfarbe haben und kontrolliert außerdem ob diese doppelt sind , und wenn ja dann werden diese nur einmal gezählt. Soweit funktioniert das prima. Ich bräuchte folgende Änderung. Es soll nur Zeilenweise nach dopplelten Werten gesucht werden und nicht Bereichsweise. Soll heißen, wenn in einer Zeile eine Zelle doppelt ist soll diese nur einmal gezählt werden, wenn die Zelle aber in der nächsten Zeile noch mal vorkommt soll sie nochmal gezählt werde. Also ich möchte schon einen bereich durchsuchen aber nur die doppelten zeilenweise nicht bereichsweise kontrollieren. Man müsste das Programm so abändern, dass Zeile für Zeile kontrolliert wird bis der komplette Bereich durchsucht wurde eine Schleife in der Schleife denk ich mal. Ich hoffe Ihr könnt mit meiner Beschreibung was anfangen.


Sub Rote_Finden()
Application.ScreenUpdating = False
'Sheets("Tabelle1").Activate
Dim Anfang As Long
Dim Ende As Long
Anfang = Range("AA2") ' Zeile des Aktuellen Datums
Ende1 = Range("AC2")   ' Datum plus Anzahl Tage in der Zukunft
Sheets("Belegungsplan").Activate
Dim Zelle As Range
Dim Zelle1 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" & Ende1)
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    ' J wird durch 7 geteilt (E:K E bis K = 7)
'Am Ende jeder Zeile wird die Anzahl roter Zellen in Spalte A
'von Tabelle2 geschrieben
Sheets("Belegungsplan").Cells(Zelle.Row, 27) = anzRote  ' Spalte AA
Sheets("Belegungsplan").Cells(Zelle.Row, 28) = anzRote  ' Spalte AB
anzRote = 0
End If
j = j + 1
Next Zelle
Sheets("Belegungsplan").Activate
Application.ScreenUpdating = True
'MsgBox "Anzahl roter Texte: " & colGefunden.Count
End Sub

Danke für Eure Hilfe und Sorry für die schlechte Beschreibung vorher
Gruß
Markus

Beliebteste Forumthreads (12 Monate)

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread