Supportnet / Forum / Tabellenkalkulation
Farbe der Zellen ändern
Frage
Hi,
hier meine "Frage"
wer kann mir nachfoldenden code erweitern,
ich will nicht nur die farbe der zellen ändern sonder auch die schriftfarbe festlegen(schriftfarbe ist anders als zell farbe.
Sub Ersetzen()
Dim I As Integer, Spalte As Integer, iFarbe
For I = 1 To ThisWorkbook.Sheets.Count
Select Case UCase(Worksheets(I).Name)
Case "JANUAR", "FEBRUAR", "MÄRZ", "APRIL", "MAI", "JUNI", "JULI", _
"AUGUST", "SEPTEMBER", "OKTOBER", "NOVEMBER", "DEZEMBER"
' Formeln ersetzen durch Werte mit Formate
Worksheets(I).Rows(42).Copy
With Worksheets(I).Rows(44)
' Werte
.PasteSpecial Paste:=xlValues
' Formate
.PasteSpecial Paste:=xlFormats
End With
End Select
Next I
Application.CutCopyMode = False
'überprüft jetzt alle Spalten in zeile 44 auf den vorh. Eintrag
For Spalte = 1 To 255
Select Case Cells(44, Spalte)
Case "A"
iFarbe = 6
Case "B"
iFarbe = 15
Case "F"
iFarbe = 4
Case "X"
iFarbe = 2
Case "S"
iFarbe = 3
Case Else
iFarbe = xlNone
End Select
Range(Cells(1, Spalte), Cells(35, Spalte)).Interior.ColorIndex = iFarbe
Next Spalte
End Sub
für eure hilfe wäre ich sehr dankdar.
Antwort 1 von nighty
hi marcus :)
vielleicht so :)
gruss nighty
nicht getestet
Sub Ersetzen()
Dim I As Integer, Spalte As Integer, iFarbe, sFarbe
For I = 1 To ThisWorkbook.Sheets.Count
Select Case UCase(Worksheets(I).Name)
Case "JANUAR", "FEBRUAR", "MÄRZ", "APRIL", "MAI", "JUNI", "JULI", _
"AUGUST", "SEPTEMBER", "OKTOBER", "NOVEMBER", "DEZEMBER"
' Formeln ersetzen durch Werte mit Formate
Worksheets(I).Rows(42).Copy
With Worksheets(I).Rows(44)
' Werte
.PasteSpecial Paste:=xlValues
' Formate
.PasteSpecial Paste:=xlFormats
End With
End Select
Next I
Application.CutCopyMode = False
'überprüft jetzt alle Spalten in zeile 44 auf den vorh. Eintrag
For Spalte = 1 To 255
Select Case Cells(44, Spalte)
Case "A"
iFarbe = 6
sFarbe = 1
Case "B"
iFarbe = 15
sFarbe = 2
Case "F"
iFarbe = 4
sFarbe = 3
Case "X"
iFarbe = 2
sFarbe = 4
Case "S"
iFarbe = 3
sFarbe = 5
Case Else
iFarbe = xlNone
sFarbe = xlNone
End Select
Range(Cells(1, Spalte), Cells(35, Spalte)).Interior.ColorIndex = iFarbe
Range(Cells(1, Spalte), Cells(35, Spalte)).Font.ColorIndex = sFarbe
Next Spalte
End Sub
vielleicht so :)
gruss nighty
nicht getestet
Sub Ersetzen()
Dim I As Integer, Spalte As Integer, iFarbe, sFarbe
For I = 1 To ThisWorkbook.Sheets.Count
Select Case UCase(Worksheets(I).Name)
Case "JANUAR", "FEBRUAR", "MÄRZ", "APRIL", "MAI", "JUNI", "JULI", _
"AUGUST", "SEPTEMBER", "OKTOBER", "NOVEMBER", "DEZEMBER"
' Formeln ersetzen durch Werte mit Formate
Worksheets(I).Rows(42).Copy
With Worksheets(I).Rows(44)
' Werte
.PasteSpecial Paste:=xlValues
' Formate
.PasteSpecial Paste:=xlFormats
End With
End Select
Next I
Application.CutCopyMode = False
'überprüft jetzt alle Spalten in zeile 44 auf den vorh. Eintrag
For Spalte = 1 To 255
Select Case Cells(44, Spalte)
Case "A"
iFarbe = 6
sFarbe = 1
Case "B"
iFarbe = 15
sFarbe = 2
Case "F"
iFarbe = 4
sFarbe = 3
Case "X"
iFarbe = 2
sFarbe = 4
Case "S"
iFarbe = 3
sFarbe = 5
Case Else
iFarbe = xlNone
sFarbe = xlNone
End Select
Range(Cells(1, Spalte), Cells(35, Spalte)).Interior.ColorIndex = iFarbe
Range(Cells(1, Spalte), Cells(35, Spalte)).Font.ColorIndex = sFarbe
Next Spalte
End Sub