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