Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
956to960
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
956to960
956to960
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Worksheet_Change auf Spalten beschränken

Worksheet_Change auf Spalten beschränken
10.03.2008 19:19:00
topdog

Hallo da draussen...
Nochmal ein kleines Problem

Private Sub Worksheet_Change(ByVal lRange As Range)
Call Check(ThisWorkbook.ActiveSheet.Name)
End Sub


mit diesem Code rufe ich ein Modul in VBA auf, das mir mehrere Bedingte Formatierungen als 3 erlaubt. Jetzt isses ja immo so,
das bei jeder Änderung in dem Sheet das Modul aufgerufen und durchlaufen wird.
Da dieses Modul nicht gerade klein ist, dauert es immer eine kleine Ewigkeit, bis es durchlaufen ist.
Gibt es ne möglichkeit, das dieses Modul nur dann aufgerufen wird, wenn in Spalte M,N,Q,oder R eine Änderung
vorgenommen wird?
Wenn ja wie?
Oder gibt es vllt ne Möglichkeit diesen "Brocken" von Modul zu "verkürzen"?
Sub Check(ByVal strSheet As String)
Dim lR As Integer, lC As Integer
lC = 12 'Zwölfte Spalte, Spalte in der die bedingte Formatierung angelegt werden soll
With ThisWorkbook.Worksheets(strSheet)
For lR = 8 To 3000 'Zeile 8 bis 3000 'Zeilen in den die bedingte Formatierung angelegt werden soll
With Cells(lR, lC) 'Zelle auswählen
If (.Value = "Beim Prüfen") Then ' Wenn der Wert "Beim Prüfen" ist, dann mach....
.Interior.Pattern = xlGray50 'legt die "Dichte" des Musters fest
.Interior.PatternColorIndex = 46 'legt die Farbe des Musters fest
.Interior.ColorIndex = xlAutomatic 'legt die Hintergrundfarbe fest
.Font.ColorIndex = xlAutomatic ' legt die Schriftfarbe fest
.Font.Bold = True 'Schriftart "Fett"
.Font.Italic = False 'Schriftart "Kursiv"
.Font.Underline = False 'Schriftart "Untersrichen"
.HorizontalAlignment = xlCenter 'Schriftart "Zentriert"
.VerticalAlignment = xlCenter 'Schriftart "vertikal Zentriert"
ElseIf (.Value = "0") Then 'Wenn der Wert "Prüfung überfällig" ist dann mach....
.Interior.Pattern = xlGray50 'legt die "Dichte" des Musters fest
.Interior.PatternColorIndex = 2 'legt die Farbe des Musters fest
.Interior.ColorIndex = 2 'legt die Hintergrundfarbe fest
.Font.ColorIndex = 2 ' legt die Schriftfarbe fest
.Font.Bold = True 'Schriftart "Fett"
.Font.Italic = False 'Schriftart "Kursiv"
.Font.Underline = False 'Schriftart "Untersrichen"
.HorizontalAlignment = xlCenter 'Schriftart "Zentriert"
.VerticalAlignment = xlCenter 'Schriftart "vertikal Zentriert"
ElseIf (.Value = "Prüfung überfällig") Then 'Wenn der Wert "Prüfung überfällig" ist dann mach....
.Interior.Pattern = xlGray50 'legt die "Dichte" des Musters fest
.Interior.PatternColorIndex = 3 'legt die Farbe des Musters fest
.Interior.ColorIndex = xlAutomatic 'legt die Hintergrundfarbe fest
.Font.ColorIndex = xlAutomatic ' legt die Schriftfarbe fest
.Font.Bold = True 'Schriftart "Fett"
.Font.Italic = False 'Schriftart "Kursiv"
.Font.Underline = False 'Schriftart "Untersrichen"
.HorizontalAlignment = xlCenter 'Schriftart "Zentriert"
.VerticalAlignment = xlCenter 'Schriftart "vertikal Zentriert"
ElseIf (.Value = "Prüfung fällig") Then ' Wenn der Wert "Prüfung fällig" ist, dann mach....
.Interior.Pattern = xlGray50 'legt die "Dichte" des Musters fest
.Interior.PatternColorIndex = 6 'legt die Farbe des Musters fest
.Interior.ColorIndex = xlAutomatic 'legt die Hintergrundfarbe fest
.Font.ColorIndex = xlAutomatic ' legt die Schriftfarbe fest
.Font.Bold = True 'Schriftart "Fett"
.Font.Italic = False 'Schriftart "Kursiv"
.Font.Underline = False 'Schriftart "Untersrichen"
.HorizontalAlignment = xlCenter 'Schriftart "Zentriert"
.VerticalAlignment = xlCenter 'Schriftart "vertikal Zentriert"
ElseIf (.Value = "i.O.") Then ' Wenn der Wert "i.O." ist, dann mach....
.Interior.Pattern = xlGray50 'legt die "Dichte" des Musters fest
.Interior.PatternColorIndex = 4 'legt die Farbe des Musters fest
.Interior.ColorIndex = xlAutomatic 'legt die Hintergrundfarbe fest
.Font.ColorIndex = xlAutomatic ' legt die Schriftfarbe fest
.Font.Bold = True 'Schriftart "Fett"
.Font.Italic = False 'Schriftart "Kursiv"
.Font.Underline = False 'Schriftart "Untersrichen"
.HorizontalAlignment = xlCenter 'Schriftart "Zentriert"
.VerticalAlignment = xlCenter 'Schriftart "vertikal Zentriert"
ElseIf (.Value = "Versandvorbereitung") Then ' Wenn der Wert "Versandvorbereitung" ist, dann mach....
.Interior.Pattern = xlGray50 'legt die "Dichte" des Musters fest
.Interior.PatternColorIndex = 15 'legt die Farbe des Musters fest
.Interior.ColorIndex = xlAutomatic 'legt die Hintergrundfarbe fest
.Font.ColorIndex = xlAutomatic ' legt die Schriftfarbe fest
.Font.Bold = True 'Schriftart "Fett"
.Font.Italic = False 'Schriftart "Kursiv"
.Font.Underline = False 'Schriftart "Untersrichen"
.HorizontalAlignment = xlCenter 'Schriftart "Zentriert"
.VerticalAlignment = xlCenter 'Schriftart "vertikal Zentriert"
ElseIf (.Value = "INAKTIV!!!") Then ' Wenn der Wert "Versandvorbereitung" ist, dann mach....
.Interior.Pattern = xlNone 'legt die "Dichte" des Musters fest
.Interior.PatternColorIndex = xlNone 'legt die Farbe des Musters fest
.Interior.ColorIndex = xlAutomatic 'legt die Hintergrundfarbe fest
.Font.ColorIndex = 3 ' legt die Schriftfarbe fest
.Font.Bold = True 'Schriftart "Fett"
.Font.Italic = False 'Schriftart "Kursiv"
.Font.Underline = False 'Schriftart "Untersrichen"
.HorizontalAlignment = xlCenter 'Schriftart "Zentriert"
.VerticalAlignment = xlCenter 'Schriftart "vertikal Zentriert"
Else 'Wenn er nich von alle dem ist dann mach....
.Interior.ColorIndex = xlNone
.Font.ColorIndex = xlAutomatic
'*****************
End If 'Ende Schleife
End With 'Ende Zelle
Next lR ' Nächste Zelle ankucken
End With
End Sub


LG TopDog

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Worksheet_Change auf Spalten beschränken
10.03.2008 19:37:19
Beverly
Hi,

Private Sub Worksheet_Change(ByVal lRange As Range)
If Intersect(lRange, Union(Columns("M:N"), Columns("Q:R"))) Is Nothing Then Exit Sub
Call Check(ThisWorkbook.ActiveSheet.Name)
End Sub




AW: Worksheet_Change auf Spalten beschränken
10.03.2008 20:30:33
topdog
THX!!!
Danke Hajo für die Seite...sehr nützlich!!!!
Beverly auch dir Danke für den Lösungsvorschlag!!! Funktioniert einwandfrei
LG TopDog
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige