Supportnet / Forum / Tabellenkalkulation

Hallo Leute! Dieses Makro gibt den Farbwert einer Zelle aus! Leider scheint es die Farben von bedingten Formatierungen nicht zu mögen! Hat jemand einen Tipp, wie ich das beheben kann? Sub Farbe2() ' Liest in den Zellen A1 bis A10 die Farnummern aus ' und schreibt sie in die Zellen B1 bis B10 For r = 3 To 15 ' Beginn der For To Next Schleife Cells(r, 2) = Cells(r, 1).Interior.ColorIndex ' Hintergrundfarbe auslesen und schreiben Next r ' Ende der For To Next Schleife End Sub ' Ende des Makros Gruss Platin7

Hallo Nick,

das ist kompliziert Link zur Datei da kommst Du wohl leichter ran, fals Du die Bedingung nachbaust.

Gruß Hajo

Hallo Hajo!

Danke für den raschen Hinweis!
Aber geht es etwas weniger kompliziert!
Ich habe meine Farben in Spalte A und möchte die Werte in Spalte B!

Gruss
PLATIN7

Hallo Nick,

da haben sich schon einige dran versucht, falls Du eine einfachere Möglichkeit hast, lade Sie hoch.

Gruß Hajo

hi all :-)

fuer die bedingte form :-))

funktioniert fast immer :-)

und bedarf einer optimierung bzw korrigierung von profis

ich glaub war sogar von hajos website

gruss gast123

ein zufuegen

alt+f11/projektexplorer/allgemeines modul

nach dem ist die function unter einfuegen/function/benutzerdefiniert/BedingungAdd verfuegbar

neue formel
=BedingungAdd(bereich;farbindex)
=BedingungAdd(A1:A3;3)

Function BedingungAdd(Zellen As Range, farbe As Integer) As Double
Dim Zelle As Range
Dim farben As Integer
Application.Volatile
For Each Zelle In Zellen
farben = GetCellColor(Zelle)
If farben = farbe Then
BedingungAdd = BedingungAdd + Zelle.Value
End If
Next
End Function



Function GetCellColor(cell As Range) As IntegerDim iDim myValDim myColor As IntegerDim done As BooleanOn Error Resume NextNames("testname").DeleteOn Error GoTo 0Application.ReferenceStyle = xlR1C1myVal = cell.ValuemyColor = cell.Interior.ColorIndexdone = FalseFor i = 1 To cell.FormatConditions.CountWith cell.FormatConditions.Item(i)If .Type = 1 ThenSelect Case .OperatorCase xlBetweenIf (myVal >= Evaluate(.Formula1) And myVal <= Evaluate(.Formula2)) _Or (myVal <= Evaluate(.Formula1) And myVal >= Evaluate(.Formula2)) ThenmyColor = .Interior.ColorIndexdone = TrueEnd IfCase xlEqualIf myVal = Evaluate(.Formula1) ThenmyColor = .Interior.ColorIndexdone = TrueEnd IfCase xlGreaterIf myVal > Evaluate(.Formula1) ThenmyColor = .Interior.ColorIndexdone = TrueEnd IfCase xlGreaterEqualIf myVal >= Evaluate(.Formula1) ThenmyColor = .Interior.ColorIndexdone = TrueEnd IfCase xlLessIf myVal < Evaluate(.Formula1) ThenmyColor = .Interior.ColorIndexdone = TrueEnd IfCase xlLessEqualIf myVal <= Evaluate(.Formula1) ThenmyColor = .Interior.ColorIndexdone = TrueEnd IfCase xlNotBetweenIf myVal < Evaluate(.Formula1) Or myVal > Evaluate(.Formula2) ThenmyColor = .Interior.ColorIndexdone = TrueEnd IfCase xlNotEqualIf myVal <> Evaluate(.Formula1) ThenmyColor = .Interior.ColorIndexdone = TrueEnd IfEnd SelectElseIf .Type = 2 ThenNames.Add Name:="testname", RefersToR1C1Local:=.Formula1If Evaluate("testname") ThenmyColor = .Interior.ColorIndexdone = TrueEnd IfNames("testname").DeleteElseMsgBox "Unbekannter Typ: " & .Type, , "PANIC: In Function GetCellColor"Exit FunctionEnd IfEnd WithIf done Then Exit ForNextApplication.ReferenceStyle = xlA1GetCellColor = myColorEnd Function

hi all :-))

wow was fuer eine formatierung,das 2 makro in einer zeile,das war nicht so gewollt

gruss gast123

hi all :-)

dann nochmal :-)

gruss gast123

Function BedingungAdd(Zellen As Range, farbe As Integer) As Double
Dim Zelle As Range
Dim farben As Integer
Application.Volatile
For Each Zelle In Zellen
farben = GetCellColor(Zelle)
If farben = farbe Then
BedingungAdd = BedingungAdd + Zelle.Value
End If
Next
End Function

Function GetCellColor(cell As Range) As Integer
Dim i
Dim myVal
Dim myColor As Integer
Dim done As Boolean
On Error Resume Next
On Error GoTo 0
Application.ReferenceStyle = xlR1C1
myVal = cell.Value
myColor = cell.Interior.ColorIndex
done = False
For i = 1 To cell.FormatConditions.Count
With cell.FormatConditions.Item(i)
If .Type = 1 Then
Select Case .Operator
Case xlBetween
If (myVal >= Evaluate(.Formula1) And myVal <= Evaluate(.Formula2)) _
Or (myVal <= Evaluate(.Formula1) And myVal >= Evaluate(.Formula2)) Then
myColor = .Interior.ColorIndex
done = True
End If
Case xlEqual
If myVal = Evaluate(.Formula1) Then
myColor = .Interior.ColorIndex
done = True
End If
Case xlGreater
If myVal > Evaluate(.Formula1) Then
myColor = .Interior.ColorIndex
done = True
End If
Case xlGreaterEqual
If myVal >= Evaluate(.Formula1) Then
myColor = .Interior.ColorIndex
done = True
End If
Case xlLess
If myVal < Evaluate(.Formula1) Then
myColor = .Interior.ColorIndex
done = True
End If
Case xlLessEqual
If myVal <= Evaluate(.Formula1) Then
myColor = .Interior.ColorIndex
done = True
End If
Case xlNotBetween
If myVal < Evaluate(.Formula1) Or myVal > Evaluate(.Formula2) Then
myColor = .Interior.ColorIndex
done = True
End If
Case xlNotEqual
If myVal <> Evaluate(.Formula1) Then
myColor = .Interior.ColorIndex
done = True
End If
End Select
End If
End With
If done Then Exit For
Next
Application.ReferenceStyle = xlA1
GetCellColor = myColor
End Function

• access datenbank mittels html auslesen
• Festplatte auslesen
• standardspeicherort auslesen
• VB - Dateiattribute auslesen
• seriennummer auslesen