Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
884to888
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
884to888
884to888
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Werte aus Tabelle Lesen

Werte aus Tabelle Lesen
11.07.2007 09:07:00
Striker
Moin... Hab da mal ne Frage:
Ich möchte die Zellen einer Tabelle, anhand der Werte der Zahlen in den Zellen der Tabelle, Farbig makieren. Ich habe hierfür 7 Farben in die die Zahlen unterteilt werden sollen!
Als Beispiel: -3, -10, 0, 4, 17, 8, 11, 22, 5, -1, 13, 9
Nun soll das Makro automatisch die zahlen auslesen und die Bereiche einteilen!!! Ausserdem kann es noch sein das in den Zellen "n.V." steht, diese sollen nicht mit eingefärbt werden!
Im obigen Beispiel sollten nun die Zahlen -10 bis -5 beispielsweise blau gefärbt werden, von -4 bis 0 hellblau von 1 bis 6 grün von 7 bis 12 gelb usw.!!! Ist so etwas möglich....? Habe da auch schon einen Ansatz... Hoffe ihr könnt mir weiter helfen......

Sub bedingteFormatierungKomplett()
Dim DicOj As Object, Arr() As Variant, L As Long, Faktor As Double, D As Boolean
Dim Bereich As Range, Zelle As Range, FarbenArr() As Variant, M As Variant
FarbenArr = Array(3, 46, 45, 6, 4, 41) ' Hier die Farbnummern hinterlegen
Set DicOj = CreateObject("scripting.dictionary")
Set Bereich = Range("C69:J78")
L = 0
For Each Zelle In Bereich
If IsEmpty(Zelle) = False Then
DicOj.Add Zelle.Address(0, 0), Zelle.Value
L = L + 1
Cells(L, 256).Value = Zelle.Value
End If
Next Zelle
Set Bereich = Range(Cells(1, 256), Cells(L, 256))
Bereich.Sort Key1:=Cells(1, 256)
Arr = Bereich.Value
Bereich.ClearContents
Faktor = L / (UBound(FarbenArr) + 1)
For L = 1 To UBound(Arr)
D = False
For Each M In DicOj.keys
If DicOj(M) = Arr(L, 1) And D = False Then
'Debug.Print L; " .. "; M; "-"; DicOj(M); "="; Int(L - 1 / Faktor) ' evtl.  _
Zuordnung im Direktfenster ausgeben
Range(M).Interior.ColorIndex = FarbenArr(Int((L - 1) / Faktor))
DicOj.Remove M
D = True
End If
Next M
Next L
Set Bereich = Nothing
Set Zelle = Nothing
End Sub


2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Werte aus Tabelle Lesen
14.07.2007 05:20:00
fcs
Hallo striker,
hier mein Vorschlag zur Farbformatierung entsprechend Wertebereich des Zellinhalts.
Gruß
Franz

Sub bedingteFormatierungKomplett2()
Dim dblMin&, dblMax&, dblDelta&
Dim Bereich As Range, Zelle As Range, FarbenArr As Variant, I%
FarbenArr = Array(3, 46, 45, 6, 4, 41) ' Hier die Farbnummern hinterlegen
Set Bereich = ActiveSheet.Range("C69:J78")
'Zahlenwerte für Bereicheinteilung ermitteln
dblMin = Application.WorksheetFunction.Min(Bereich)
dblMax = Application.WorksheetFunction.Max(Bereich)
dblDelta = (dblMax - dblMin) / (UBound(FarbenArr) - LBound(FarbenArr) + 1)
'Alle Zellen im Bereich farblos machen
Bereich.Interior.ColorIndex = xlColorIndexNone
'Zellfarbe entsprechend Wertebereich zuordnen
For Each Zelle In Bereich
If IsEmpty(Zelle) = False And Zelle.Value  "n.V." Then
For I = LBound(FarbenArr) To UBound(FarbenArr)
If Zelle.Value >= dblMin + dblDelta * (I - LBound(FarbenArr)) _
And Zelle.Value 


Anzeige
AW: Korrektur - Werte aus Tabelle Lesen
14.07.2007 07:00:00
fcs
Hallo Striker,
korrigiere die Variblendeklaration in meinem vorher geposteten Code. Ich hatte versehentlich _ einige Variablen als Long statt Double deklariert.

Dim dblMin#, dblMax#, dblDelta#


Gruß
Franz

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige