Das Archiv des Excel-Forums

Farben

    Bild

    Betrifft: Farben
    von: Udo

    Geschrieben am: 11.10.2003 09:12:38

    Hallo Zusammen,

    ich habe hier ein nettes Macro zum Färben von Zeilen.
    Ich möchte es aber so haben das sich die ZELLEN nach den Farben sich Einzel Einfärben wie zum Beispiel: A1 (1) = Rot Zelle A2 (2) = Blau.

    Frage wer kann mir das so umschreiben das daß geht ???.

    Danke für jeden Rat

    Udo



    
Sub Hintergrundfarbe()
I = 3
Range("A" & I).Select
Do While Range("A" & I) <> ""
Range("A" & I).Select
WERT = ActiveCell
ActiveCell.Range("A1:L1").Select
Select Case WERT
Case Is = 1
With Selection.Interior
.ColorIndex = 3 'rot
.Pattern = xlSolid
End With
Case Is = 2
With Selection.Interior
.ColorIndex = 2 ' grün
.Pattern = xlSolid
End With
Case Is = 3
With Selection.Interior
.ColorIndex = 6 ' gelb
.Pattern = xlSolid
End With
Case Else
With Selection.Interior
.ColorIndex = 17 ' helblau
.Pattern = xlSolid
End With
End Select
I = I + 1
Loop
Range("A2:L" & I - 1).Select
With Selection.Borders(xlLeft)
.Weight = xlThin
.ColorIndex = 15
End With
With Selection.Borders(xlRight)
.Weight = xlThin
.ColorIndex = 15
End With
With Selection.Borders(xlTop)
.Weight = xlThin
.ColorIndex = 15
End With
With Selection.Borders(xlBottom)
.Weight = xlThin
.ColorIndex = 15
End With
Range("A" & I).Select
End Sub

    Bild


    Betrifft: AW: Farben
    von: Björn
    Geschrieben am: 11.10.2003 12:09:22

    Huhu Udo,

    versuch s mal damit:

    
Sub färben()
Dim iRow%, iCol%, iRowEnde%, iColEnde%
iRow = 1
iCol = 1
iRowEnde = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
iColEnde = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Column
Do While Cells(iRow, iCol).Row <= iRowEnde
iCol = 1
Do While Cells(iRow, iCol).Column <= iColEnde
Select Case Cells(iRow, iCol).Value
Case Is = 1
With Cells(iRow, iCol).Interior
.ColorIndex = 3 'rot
.Pattern = xlSolid
End With
Case Is = 2
With Cells(iRow, iCol).Interior
.ColorIndex = 2 ' grün
.Pattern = xlSolid
End With
Case Is = 3
With Cells(iRow, iCol).Interior
.ColorIndex = 6 ' gelb
.Pattern = xlSolid
End With
Case Else
With Cells(iRow, iCol).Interior
.ColorIndex = 17 ' helblau
.Pattern = xlSolid
End With
End Select
iCol = iCol + 1
Loop
iRow = iRow + 1
Loop
End Sub



    Gruß

    Björn


    Bild


    Betrifft: AW: Farben
    von: ChrisL
    Geschrieben am: 11.10.2003 12:26:45

    Hi

    Noch ein kleiner Verbesserungsvorschlag...

    Option Explicit

    
Sub färben()
Dim iRow%, iCol%, iRowEnde%, iColEnde%
iRow = 1
iCol = 1
iRowEnde = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
iColEnde = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Column
Do While Cells(iRow, iCol).Row <= iRowEnde
iCol = 1
Do While Cells(iRow, iCol).Column <= iColEnde
With Cells(iRow, iCol).Interior
.ColorIndex = Farbe(Cells(iRow, iCol).Value)
.Pattern = xlSolid
End With
iCol = iCol + 1
Loop
iRow = iRow + 1
Loop
End Sub



    
Function Farbe(Wert As Variant) As Byte
Select Case Wert
Case 1: Farbe = 3
Case 2: Farbe = 2
Case 3: Farbe = 6
Case Else: Farbe = 17
End Select
End Function



    Gruss
    Chris


    Bild


    Betrifft: AW: Farben
    von: Udo
    Geschrieben am: 11.10.2003 14:19:17

    Hallo,

    DANKE !!! SUPER DIE HILFE......

    Noch eine Frage kann man das Begrenzen auf einen Bereich von A1-A20 und bis K1-K20

    Nochmals Danke

    Udo


    Bild


    Betrifft: Farben
    von: Udo
    Geschrieben am: 11.10.2003 21:46:13

    Hallo Zusammen,

    Danke für Eure Hilfe.

    Noch eine Kleinigkeit

    Wie mache ich das in der Zelle mit der Farbe Rot auch der Wert 1 drin steht ???



    
Sub färben()
Dim iRow%, iCol%, iRowEnde%, iColEnde%
iRow = 1
iCol = 1
iRowEnde = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
iColEnde = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Column
Do While Cells(iRow, iCol).Row <= iRowEnde
iCol = 1
Do While Cells(iRow, iCol).Column <= iColEnde
With Cells(iRow, iCol).Interior
.ColorIndex = Farbe(Cells(iRow, iCol).Value)
.Pattern = xlSolid
End With
iCol = iCol + 1
Loop
iRow = iRow + 1
Loop
End Sub






    
Function Farbe(Wert As Variant) As Byte
Select Case Wert
Case 1: Farbe = 3
Case 2: Farbe = 2
Case 3: Farbe = 6
Case Else: Farbe = 17
End Select
End Function


    Danke Udo


    Bild


    Betrifft: AW: Farben
    von: Björn
    Geschrieben am: 12.10.2003 22:24:50

    hi Udo,

    deine Frage verstehe ich nicht. Daß die Zelle den Wert 1 enthält, ist doch Voraussetzung dafür, daß Sie rot hinterlegt werden soll? Oder ist das so zu verstehen, daß es bei Beginn des Scripts auch LEERE Zellen mit rotem HiGu gibt, in die dann im Fortlauf der Wert 1 eingetragen werden soll? Dann einfach umdrehen das Ganze. Übrigens solltest Du noch ein isnumeric einbauen für den Fall, daß auch Text eingegeben werden könnte. Nachstehend mein modifizierter Ursprungsvorschlag. Mußt Du halt in Chris Sinne umschreiben:

    
Sub färben()
Dim iRow%, iCol%, iRowEnde%, iColEnde%
iRow = 1
iCol = 1
iRowEnde = ActiveSheet.cells.SpecialCells(xlCellTypeLastCell).Row
iColEnde = ActiveSheet.cells.SpecialCells(xlCellTypeLastCell).Column
Do While cells(iRow, iCol).Row <= iRowEnde
iCol = 1
Do While cells(iRow, iCol).Column <= iColEnde
Select Case cells(iRow, iCol).Interior.ColorIndex
Case Is = 3
With cells(iRow, iCol)
.Value = 1
End With
End Select
If IsNumeric(cells(iRow, iCol)) Then
Select Case cells(iRow, iCol).Value
Case Is = 1
With cells(iRow, iCol).Interior
.ColorIndex = 3 'rot
.Pattern = xlSolid
End With
Case Is = 2
With cells(iRow, iCol).Interior
.ColorIndex = 2 ' grün
.Pattern = xlSolid
End With
Case Is = 3
With cells(iRow, iCol).Interior
.ColorIndex = 6 ' gelb
.Pattern = xlSolid
End With
Case Else
With cells(iRow, iCol).Interior
.ColorIndex = 17 ' helblau
.Pattern = xlSolid
End With
End Select
Else
With cells(iRow, iCol).Interior
.ColorIndex = 17 ' helblau
.Pattern = xlSolid
End With
End If
iCol = iCol + 1
Loop
iRow = iRow + 1
Loop
End Sub


    Übrigens liest idR niemand mehr solch alte Postings. Hier empfiehlt es sich einen neuen Thread aufzumachen. Netiquette hin oder her.

    Viele Grüße

    Björn

    P.S.:
    Deine andere Frage mit Bereichseingrenzung habe ich ebenfalls nicht so recht verstanden.


    Bild


    Betrifft: AW: Farben
    von: ChrisL
    Geschrieben am: 13.10.2003 11:09:18

    Hi Udo

    Gebe Björn recht, deine Frage ist auch mir nicht ganz klar. Nachstehend noch ein Alternativvorschlag.

    Option Explicit

    
Sub färben()
Dim Zelle As Range
For Each Zelle In ActiveSheet.Range("A1:A20, K1:K20")
If IsNumeric(Zelle) Then
With Zelle.Interior
.ColorIndex = Farbe(Zelle)
.Pattern = xlSolid
End With
End If
Next Zelle
End Sub



    
Function Farbe(Wert As Variant) As Byte
Select Case Wert
Case 1: Farbe = 3
Case 2: Farbe = 2
Case 3: Farbe = 6
Case Else: Farbe = 17
End Select
End Function



    Gruss
    Chris


     Bild

    Excel-Beispiele zum Thema " Farben"

    Zellinnenfarben über VBA festlegen download Ändern von Chart-Farben in Abhängigkeit der Daten download
    Tabelle nach Farben sortieren download Artikel mit den in einem Farbindex hinterlegten Farben markieren download
    Shapes in Abhängigkeit von Zellwerten färben download