Live-Forum - Die aktuellen Beiträge
Datum
Titel
19.04.2024 14:04:05
PDF per VBA ausgeben - Seitenskalierung
19.04.2024 13:58:02
Set Worksheet geht im O365 aber im Excel 2016 nicht
19.04.2024 13:49:38
Per Kopfdruck als pdf speichern und Mail erstellen
19.04.2024 12:58:59
Daten einfügen aus anderem Sheet
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
320to324
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
320to324
320to324
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Farben

Farben
11.10.2003 09:12:38
Udo
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

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

Betreff
Datum
Anwender
Anzeige
AW: Farben
11.10.2003 12:09:22
Björn
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
Anzeige
AW: Farben
11.10.2003 12:26:45
ChrisL
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
Anzeige
AW: Farben
11.10.2003 14:19:17
Udo
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
Farben
11.10.2003 21:46:13
Udo
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
Anzeige
AW: Farben
12.10.2003 22:24:50
Björn
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.
Anzeige
AW: Farben
13.10.2003 11:09:18
ChrisL
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
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige