Anzeige
Archiv - Navigation
1176to1180
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Spalte prüfen

Spalte prüfen
walli
Guten Morgen,
ich möchte gern eine Spalte überprüfen.
Wenn z.b. in der Spalte ein Text steht: "Stuhl" dann sollte die Schrift ROT werden.
Vielleicht ein Makro was ich selbst mal ändern kann, z.b. eine bestimmte Zahl oder die
Zelle LEER ist etc.,
mfg walli
geht es nicht mit Bedingter Formatierung? oT.
26.09.2010 12:04:43
Tino
AW: geht es nicht mit Bedingter Formatierung? oT.
26.09.2010 14:22:31
walli
Hallo Tino,
nein, ich möchte mir gern ein Makro dann zusammenstellen, was ich immer mal ändern kann.
z.b.
ActiveSheet
Spaltennummer
Anfang Zeilennummer
Ende Zeile
mfg walli
hier mal eine Variante
26.09.2010 15:31:34
Tino
Hallo,
, Code kommt in die entsprechende Tabelle.
Argumente anpassen, Bereich anpassen, Farbe anpassen.
kommt als Code in die Tabelle Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Dim ArrayArgumente Dim i As Integer Dim rngBereich As Range 'Farbe festlegen Const IntFarbe As Integer = 3 'Farbe anpassen 'wo soll der Code wirken Set rngBereich = Range("A1:E100") 'Bereich anpassen 'Target nicht im Wirkungsbereich? --> Abbruch If Intersect(rngBereich, Target) Is Nothing Then Exit Sub ArrayArgumente = Array("Stuhl", "Tisch") 'Argumente entsprechend anpassen 'Suchen ausführen um ersetzen auf gesamter Mappe abzuschalten Cells(Rows.Count, Columns.Count).Find "" With Application 'Bildschirm einfrieren .ScreenUpdating = False 'Events abstellen .EnableEvents = False 'Farbe zurücksetzen rngBereich.Interior.ColorIndex = xlColorIndexNone 'Ersetzenformat zurücksetzen .ReplaceFormat.Clear .ReplaceFormat.Interior.ColorIndex = IntFarbe 'Schleife über Argumente im Array For i = Lbound(ArrayArgumente) To Ubound(ArrayArgumente) 'Suchen und ersetzen rngBereich.Replace What:=ArrayArgumente(i), Replacement:=ArrayArgumente(i), _ LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=True Next i .ScreenUpdating = True .EnableEvents = True End With End Sub Gruß Tino
Anzeige
Die ganze Spalte wird Rot
26.09.2010 15:43:12
walli
Hallo Tino,
die ganze Spalte wird Rot, wenn ich in einer Spalte
etwas geändert habe.
Ich möchte die Prüfung per Makro auslösen,
mfg walli
So geht die Farbe raus klappt auch --))
26.09.2010 16:09:19
walli
Hallo Tino,
vielleicht liegt es daran, ich habe eine Formel in jeder Celle. !!!
Danke für dein Beispiel !!!
Sub Rot_raus()
Dim i As Long
For i = 4 To ActiveSheet.Range("B4:B65000").End(xlDown).Row
If ActiveSheet.Range("B" & i).Cells.Font.ColorIndex = 3 Then
ActiveSheet.Range("B" & i).Cells.Font.ColorIndex = 1
End If
Next i
End Sub
mfg walli
Anzeige
AW: So geht die Farbe raus klappt auch --))
26.09.2010 16:38:02
Tino
Hallo,
isch würde es demnach so machen.
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ArrayArgumente
Dim i As Integer
Dim rngBereich As Range, rngTmp As Range
'Farbe festlegen 
Const IntFarbe As Integer = 3 'Farbe anpassen 
'wo soll der Code wirken 
Set rngBereich = Range("B4:B" & Rows.Count) 'Bereich anpassen 
'Target nicht im wirkungsbereich? --> Abbruch 
If Intersect(rngBereich, Target) Is Nothing Then Exit Sub

ArrayArgumente = Array("Stuhl", "Tisch") 'Argumente entsprechend anpassen 
'Suchen ausführen um ersetzen auf gesamter Mappe abzuschalten 
Cells(Rows.Count, Columns.Count).Find ""

With Application
    'Bildschirm einfrieren 
    .ScreenUpdating = False
    'Events abstellen 
    .EnableEvents = False
    
    rngBereich.Interior.ColorIndex = xlColorIndexNone
    For i = Lbound(ArrayArgumente) To Ubound(ArrayArgumente)
            Set rngTmp = Suche_(rngBereich, ArrayArgumente(i))
            If Not rngTmp Is Nothing Then _
                rngTmp.Interior.ColorIndex = IntFarbe
    Next i
    
    .ScreenUpdating = True
    .EnableEvents = True
End With
End Sub

Private Function Suche_(rngBereich As Range, ByVal SuchText As String) As Range
Dim rngRange As Range, rngTemp As Range, strErste As String
Set rngRange = rngBereich.Find(SuchText, LookIn:=xlValues, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False)

If Not rngRange Is Nothing Then
    strErste = rngRange.Address
    Set rngTemp = rngRange
    Set rngRange = rngBereich.FindNext(rngRange)
    Do While strErste <> rngRange.Address
        Set rngTemp = Union(rngTemp, rngRange)
        Set rngRange = rngBereich.FindNext(rngRange)
    Loop
    Set Suche_ = rngTemp
End If
End Function
Gruß Tino
Anzeige
Hallo Tino, PERFEKT !!! Danke --))
26.09.2010 17:20:24
walli
viellecht so ohne vba
26.09.2010 12:17:41
Matthias
Hallo
Tabelle1

 ABCDE
2Der Stuhl steht im Keller Suchtext - > stuhl
3Stuh    
4Stul    
5Stuhlbein    

Bedingte Formatierungen der Tabelle
ZelleNr.: / BedingungFormat
A21. / Formel ist =SUCHEN($E$2;A2;1)>0Abc
A31. / Formel ist =SUCHEN($E$2;A3;1)>0Abc
A41. / Formel ist =SUCHEN($E$2;A4;1)>0Abc
A51. / Formel ist =SUCHEN($E$2;A5;1)>0Abc


Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4
Gruß Matthias
Anzeige
Matthias danke für die Formel
26.09.2010 14:24:36
walli
Hallo Matthias,
Formel ist ja i.o aber Makro ist vielleicht für die Zunkunft besser ?
mfg Walli
Hallo zusammen, habe was gefunde --)
26.09.2010 15:53:02
walli
Hallo zusammen,
habe dies gefunden:
Sub www()
Dim i As Long
For i = 4 To ActiveSheet.Range("B4:B65000").End(xlDown).Row
If ActiveSheet.Range("B" & i).Value = "Stuhl" Then
ActiveSheet.Range("B" & i).Font.ColorIndex = 3
End If
Next i
End Sub
und es klappt !
Danke,
mfg walli
Vielleicht ein Tip noch ?
26.09.2010 16:04:23
walli
Hallo zusammen,
wie bekomme ich die Farbe zurück ?
So geht es leider nicht :
Dim i As Long
For i = 4 To ActiveSheet.Range("B4:B65000").End(xlDown).Row
If ActiveSheet.Range("B" & i).Value = .Cells(.Font.ColorIndex) = 3 Then
ActiveSheet.Range("B" & i .Cells(.Font.ColorIndex) = 1
End If
Next i
mfg walli
Anzeige
AW: Vielleicht ein Tip noch ?
26.09.2010 16:23:43
hary
Hallo Walli
der Tip mit.

ActiveSheet.Columns(2).Font.ColorIndex = xlAutomatic

gleich unter Dim zeile
gruss hary
AW: Vielleicht ein Tip noch ?
26.09.2010 16:32:32
Gerd
Hallo Walli!
Dann tippe ich noch etwas weiter. :-)
Private Sub Worksheet_Change(ByVal Target As Range)
Const strBegriff As String = "Stuhl"
Dim rngCell As Range, rngFuellbereich As Range
Set rngFuellbereich = Intersect(Target, Range("B4:B65536"))
If rngFuellbereich Is Nothing Then Exit Sub
For Each rngCell In Fuellbereich
Select Case rngCell.Value
Case strBegriff
rngCell.Font.ColorIndex = 3
Case Else
rngCell.Font.ColorIndex = xlAutomatic
End Select
Next rngCell
End Sub

Gruß Gerd
Anzeige
Ja aber -)
26.09.2010 17:27:16
walli
Hallo Gerd,
ebenfalls perfekt, habe dies geändert dann einwandfrei.
For Each rngCell In rngFuellbereich
Achönen Sonntag noch,
mfg walli
Auch Dir, Danke Hary ! -)
26.09.2010 17:21:39
walli

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige