Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
VBA Zellen einfärben
WalterK
Hallo,
aus dem Internet (woher ist mir nicht mehr erinnerlich) habe ich einen Code erfragt, der bestimmte Zellen mit bestimmten Hintengrundfarben einfärbt.
Der Code funktioniert noch nicht optimal, darum wende ich mich an Euch.
Zur genauen Beschreibung des Problems habe ich eine Arbeitsmappe hochgeladen.
Hier die Datei:
https://www.herber.de/bbs/user/81172.xls
Besten Dank an die Helfer,
Servus, Walter

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: VBA Zellen einfärben
26.07.2012 23:32:38
fcs
Hallo Walter,
so sollte es funktionieren.
Gruß
Franz
Sub LK_einfärben()
'Teil 1 - sucht die Spalte Bezeichnung und färbt Zellen mit identischem Text gleich ein,
'falls für diesen Text manuell eine Farbe hinterlegt wurde.
'Es soll eine MsgBox erscheinen, wenn die Überschrift BEZEICHNUNG fehlt oder überhaupt
'keine Zelle in der Spalte BEZEICHNUNG manuell farblich hinterlegt wurde.
Dim rngBezeich As Range
Dim Zelle As Range
Dim myDic As Object
Set myDic = CreateObject("scripting.Dictionary")
Dim MyBool As Boolean, varBezeich As Variant, varBeginn As Variant, varEnde As Variant
On Error GoTo ErrHandler:
With ActiveSheet
varBezeich = Application.Match("BEZEICHNUNG", .Rows(2), 0)
varBeginn = Application.Match("JÄNNER", .Rows(2), 0)
varEnde = Application.Match("DEZEMBER", .Rows(2), 0)
If IsError(varBezeich) Then
MsgBox "Spalte ""BEZEICHUNG"" nicht vorhanden", _
vbInformation, "Makro: LK_einfärben"
GoTo ErrHandler
End If
Application.ScreenUpdating = False
Set rngBezeich = Intersect(.Range("A2").CurrentRegion, _
.Rows(2).Find("BEZEICHNUNG").EntireColumn)
'gefärbte Zellen ermitteln
For Each Zelle In rngBezeich
If Zelle.Interior.ColorIndex  xlColorIndexNone Then
If Not myDic.exists(Zelle.Value) Then
myDic(Zelle.Value) = Zelle.Interior.Color
MyBool = True
End If
End If
Next
If MyBool = False Then
MsgBox "In Spalte ""BEZEICHNUNG"" sind keine Zellen eingefärbt", _
vbInformation, "Makro: LK_einfärben"
GoTo ErrHandler
End If
'Zellen gleicher Bezeichung und Bereich JÄNNER bis DEZEMBER einfärben
For Each Zelle In rngBezeich
If myDic.exists(Zelle.Value) Then
'***Teil 1 - Zellen in Spalte "BEZEICHNUNG" färben
Zelle.Interior.Color = myDic(Zelle.Value)
'***Teil 2 - färbt die Spalten von JÄNNER bis DEZEMBER ein.
If Not (IsError(varBeginn) Or IsError(varEnde)) Then
.Range(.Cells(Zelle.Row, varBeginn), .Cells(Zelle.Row, varEnde)).Interior.Color _
= myDic(Zelle.Value)
End If
End If
Next
End With
If IsError(varBeginn) Or IsError(varEnde) Then
MsgBox "In Zeile 2 fehlt die Überschrift JÄNNER oder DEZEMBER!", _
vbInformation, "Makro: LK_einfärben"
End If
ErrHandler:
If Err.Number  0 Then
MsgBox "Sonstiger Fehler-Nr.: " & Err.Number & vbCr _
& Err.Description, vbCritical, "Makro: LK_einfärben"
End If
Application.ScreenUpdating = True
End Sub

Anzeige
AW: VBA Zellen einfärben
27.07.2012 08:51:16
WalterK
Hallo Franz,
besten Dank für Deine Hilfe, alles (bis auf eine Kleinigkeit) funktioniert genauso wie ich es haben wollte.
die Kleinigkeit: wenn in der Spalte Bezeichnung ab Zeile 3 noch keine Farbe hinterlegt wurde sollte eine entsprechende MsgBox angezeigt werden.
Nochmals Danke und Servus, Walter
bist Du Dir da wirklich sicher ?
27.07.2012 09:28:11
Matthias
Hallo Walter
Userbild
Gruß Matthias
AW: bist Du Dir da wirklich sicher ?
27.07.2012 09:42:00
WalterK
Hallo Matthias,
Du hast recht, es funktioniert.
Bei mir hat es nicht funktioniert, weil ich übersehen und auch vergessen habe zu erwähnen, dass in der Originaltabelle die Zeilen 1 und 2 schon eingefärbt sind wenn ich sie erhalte.
Was muss ich im Code ändern, damit bei der Prüfung, ob in der Spalte Bezeichnung schon Farben hinterlegt sind, die Zeilen 1 und 2 außer acht gelassen werden.
Besten Dank für Deine Hilfe, Servus Walter
Anzeige
AW: bist Du Dir da wirklich sicher ?
27.07.2012 09:58:19
fcs
Hallo Walter,
passe die Zeile mit "Set rngBezeich =" wie folgt an, damit nur die Zeilen ab Zeile 3 bearbeitet werden.
    Set rngBezeich = .Range(.Cells(3, varBezeich), .Cells(.Rows.Count, varBezeich).End(xlUp))

Gruß
Franz
Perfekt! Besten Dank! Servus Walter
27.07.2012 10:04:33
WalterK
.

318 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige