Schraffieren einer Zelle

Forumthread: Schraffieren einer Zelle

29.05.2006 12:05:27

Catweezle

Hallo!
Ein Arbeitskollege hat mir mal folgendes Makro geschrieben, mit dem ich eine Zelle schraffieren konnte, wenn in einer anderen Zelle derselben Zeile ein bestimmtes Kürzel auftaucht Kollege arbeitet nicht mehr bei uns, das Makro bräuchte eine Anpassung, könnt Ihr mir helfen?
Das Makro bewirkt, dass Zellen der Spalte BC rot schraffiert werden, sobald in einer anderen Zelle derselben Zeile die Kürzel "ws" oder "odws" auftauchen. Das funktioniert gut, ABER: Wenn ich das Kürzel "ws" oder "odws" entferne nimmt es die rote Schraffur nicht mehr weg. Wie kriege ich das auch noch hin?
Danke und Grüsse!
Heiko
Makro:
Option Explicit
Public


Sub CheckWS_WH()
On Error GoTo Fehler
Dim ALetzte, BLetzte, i As Long, j As Long
Dim hilf As String
Dim wb2 As Workbook
Dim wks2 As Worksheet
Dim k As Integer
Dim Bereich As Range
Application.ScreenUpdating = False
Set wb2 = ThisWorkbook
Set wks2 = wb2.Sheets("OA + OAss")
ALetzte = IIf(IsEmpty(wks2.Range("A65536")), wks2.Range("A65536").End(xlUp).Row, 65536)
For i = 8 To ALetzte
wks2.Cells(i, 55).Interior.Pattern = xlSolid
For k = 4 To 43
If LCase(wks2.Cells(i, k)) = "ws" Or LCase(wks2.Cells(i, k)) = "odws" Then
hilf = wks2.Cells(7, k)
If hilf = "" Then hilf = wks2.Cells(7, k - 1)
If hilf = "Du" Or hilf = "Kr" Then
Else
With wks2.Cells(i, 55).Interior
'.ColorIndex = 0
.Pattern = xlGray16
.PatternColorIndex = 7
End With
End If
End If
Next
If (Format(wks2.Cells(i, 2), "dd.mm") = "31.12") Then Exit For
Next
Application.ScreenUpdating = True
Exit Sub
Fehler:
MsgBox "Fehler" & vbLf & Err.Description
End Sub

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

AW: Schraffieren einer Zelle

29.05.2006 14:26:25

Franz

AW: Schraffieren einer Zelle

29.05.2006 14:26:25

Franz

Hallo Heiko,
starte das Makro noch einmal nachdem die ws bzw. odws entfernt wurden. Dann wird das Format auf das in dieser Zeile definierte Format zurückgesetzt:


For i = 8 To ALetzte
wks2.Cells(i, 55).Interior.Pattern = xlSolid
For k = 4 To 43

Falls die Anpassung des Formats beim Löschen von ws bzw. odws-Einträgen immer sofort passieren soll, dann muss du folgendes Makro unter der Tabelle im VBA-Editor einfügen. Es wird dann jeweils die Zeile überprüft in der Änderungen gemacht werden


Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Target.Column >= 4 And Target.Column <= 43 And Target.Row >= 8 Then
On Error GoTo Fehler
Dim BLetzte, i As Long, j As Long
Dim hilf As String
Dim wb2 As Workbook
Dim wks2 As Worksheet
Dim k As Integer
Dim Bereich As Range
Application.ScreenUpdating = False
Set wb2 = ThisWorkbook
Set wks2 = wb2.Sheets("OA + OAss")
i = Target.Row
wks2.Cells(i, 55).Interior.Pattern = xlSolid
For k = 4 To 43
If LCase(wks2.Cells(i, k)) = "ws" Or LCase(wks2.Cells(i, k)) = "odws" Then
hilf = wks2.Cells(7, k)
If hilf = "" Then hilf = wks2.Cells(7, k - 1)
If hilf = "Du" Or hilf = "Kr" Then
Else
With wks2.Cells(i, 55).Interior
'.ColorIndex = 0
.Pattern = xlGray16
.PatternColorIndex = 7
End With
End If
End If
Next
Application.ScreenUpdating = True
Exit Sub
Fehler:
MsgBox "Fehler" & vbLf & Err.Description
End If
End Sub

Gruß
Franz

Infobox / Tutorial

Zellen in Excel schraffieren: Ein Leitfaden für Makros und Anpassungen

Schritt-für-Schritt-Anleitung
Häufige Fehler und Lösungen
Alternative Methoden
Praktische Beispiele
Tipps für Profis
FAQ: Häufige Fragen

Schritt-für-Schritt-Anleitung

Makro erstellen: Öffne den VBA-Editor mit ALT + F11. Füge ein neues Modul hinzu und kopiere den folgenden Code:

Sub CheckWS_WH()
   On Error GoTo Fehler
   Dim ALetzte As Long
   Dim k As Integer
   Dim wb2 As Workbook
   Dim wks2 As Worksheet

   Application.ScreenUpdating = False
   Set wb2 = ThisWorkbook
   Set wks2 = wb2.Sheets("OA + OAss")
   ALetzte = wks2.Cells(wks2.Rows.Count, "A").End(xlUp).Row

   For i = 8 To ALetzte
       wks2.Cells(i, 55).Interior.Pattern = xlSolid
       For k = 4 To 43
           If LCase(wks2.Cells(i, k)) = "ws" Or LCase(wks2.Cells(i, k)) = "odws" Then
               With wks2.Cells(i, 55).Interior
                   .Pattern = xlGray16
                   .PatternColorIndex = 7
               End With
           End If
       Next k
   Next i

   Application.ScreenUpdating = True
   Exit Sub
Fehler:
   MsgBox "Fehler" & vbLf & Err.Description
End Sub

Makro anpassen: Um die Schraffur zu entfernen, wenn das Kürzel gelöscht wird, füge den folgenden Code in den Arbeitsblattmodul ein:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
   If Target.Column >= 4 And Target.Column <= 43 And Target.Row >= 8 Then
       On Error GoTo Fehler
       Dim i As Long
       Dim k As Integer
       Application.ScreenUpdating = False
       i = Target.Row
       wks2.Cells(i, 55).Interior.Pattern = xlSolid
       For k = 4 To 43
           If LCase(wks2.Cells(i, k)) = "ws" Or LCase(wks2.Cells(i, k)) = "odws" Then
               With wks2.Cells(i, 55).Interior
                   .Pattern = xlGray16
                   .PatternColorIndex = 7
               End With
           End If
       Next k
   End If
Fehler:
   MsgBox "Fehler" & vbLf & Err.Description
   End If
End Sub

Makro ausführen: Starte das Makro und beobachte die Änderungen in der Excel-Tabelle.

Häufige Fehler und Lösungen

Fehler beim Ausführen des Makros: Stelle sicher, dass du die richtige Tabelle im VBA-Editor ausgewählt hast. Achte darauf, dass der Tabellennamen „OA + OAss“ korrekt ist.
Schraffur bleibt bestehen: Wenn die Schraffur nicht zurückgesetzt wird, überprüfe, ob das Makro nach dem Löschen des Kürzels ausgeführt wird. Füge den Worksheet_Change Code hinzu, um dies zu automatisieren.

Alternative Methoden

Bedingte Formatierung: Eine Alternative zum Makro ist die Verwendung der bedingten Formatierung. Gehe zu „Start“ > „Bedingte Formatierung“ > „Neue Regel“ und wähle „Formel zur Ermittlung der zu formatierenden Zellen verwenden“. Verwende die Formel:
```
=ODER(A1="ws";A1="odws")
```
Schraffur manuell einfügen: Du kannst auch manuell die Schraffur über das Menü „Format“ > „Zellen“ > „Füllung“ > „Muster“ hinzufügen.

Praktische Beispiele

Zelle schraffieren: Wenn du in Zelle D8 das Kürzel "ws" eingibst, wird die Zelle in Spalte BC (55) rot schraffiert.
Zellen schraffieren: Um mehrere Zellen in einer Zeile zu schraffieren, kannst du den gleichen Makro-Code für die gewünschten Spalten anpassen.

Tipps für Profis

Makros effizient speichern: Speichere deine Excel-Datei als „Excel-Arbeitsmappe mit Makros“ (*.xlsm), um deine Makros zu sichern.
Verwendung von VBA-Debugging: Nutze die Debugging-Funktion im VBA-Editor, um Fehler im Code schneller zu finden.
Schraffierung in Excel 365: In Excel 365 kannst du die Schraffieroptionen direkt im Formatierungsmenü finden, was die Anpassung erleichtert.

FAQ: Häufige Fragen

1. Wie kann ich in Excel eine Zelle schraffieren?
Du kannst eine Zelle schraffieren, indem du das passende Makro ausführst oder die bedingte Formatierung verwendest.

2. Funktioniert das auch in Excel 365?
Ja, die beschriebenen Methoden zur Schraffur von Zellen funktionieren auch in Excel 365. Achte darauf, die richtigen Optionen im Menü zu wählen.

3. Kann ich mehrere Zellen gleichzeitig schraffieren?
Ja, du kannst den VBA-Code anpassen, um mehrere Zellen in einer Zeile oder Spalte zu schraffieren.

Beliebteste Forumthreads (12 Monate)