Supportnet / Forum / Tabellenkalkulation
Excel Tabellenvergleich
Frage
Hallo Leutz,
ich habe ein Mächtiges Problem.
1. Ich habe eine Tabelle, in der häufig Werte geändert werden. Diese geänderten Werte möchte ich eine gewisse Zeit farblich markieren. Da andere Abteilungen über diese geänderten Werte informiert werden müssen. Nach der Informationweiterleitung sollen die Zellen wieder die Ursprüngliche Farbe annehmen.
2.a Variante 1: Macro: Die Zeilen in denen eine Änderung vorgenommen wurde sollen in einer beliebigen Spalte markiert (z.B. "x" oder Anzahl der Änderungen) werden um so nach geänderten Zeilen Filtern zu können.
2.b Variante 2: Macro: Die Zeilen in eine Änderung durchgeführt wurde werden in ein anderes Tabellenblatt kopiert.
Mein Ansatz bis Dato:
zu 1. Habe Macro geschrieben welches die Tabelle AKTUELL im gleichen Tabellenblatt kopiert (nur Werte) die kopierte Tabelle nenne ich mal Tabelle ALT. In Tabelle AKTUELL habe ich eine bedingte Formatierung eingefügt welche Zelle von Tabelle Aktuell mit ALT vergleicht und bei einer Änderung die Zelle rot markiert.
zu 2.a hier liegt das Problem, ich habe versucht ein Macro mit VBA zu schreiben das die rot hinterlegten Zellen in Tabelle AKTUELL Zeilenweise zählt, und dies in Spalte Kontrolle anzeigen soll, funktioniert leider nur nicht :((.
zu 2.b keine Ansatzlösung
Über jegliche Antwort würde ich mich sehr freuen.
Antwort 1 von nighty
hi Verzweiflungstäter :)
liesst die werte einer farbe aus die durch die bedingte formatierung hervorgerufen ist.
gruss nighty
bereich / farbe
=BedingungAdd(A1:A3;3)
liesst die werte einer farbe aus die durch die bedingte formatierung hervorgerufen ist.
gruss nighty
bereich / farbe
=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 Integer
Dim i
Dim myVal
Dim myColor As Integer
Dim done As Boolean
On Error Resume Next
Names("testname").Delete
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
ElseIf .Type = 2 Then
Names.Add Name:="testname", RefersToR1C1Local:=.Formula1
If Evaluate("testname") Then
myColor = .Interior.ColorIndex
done = True
End If
Names("testname").Delete
Else
MsgBox "Unbekannter Typ: " & .Type, , "PANIC: In Function GetCellColor"
Exit Function
End If
End With
If done Then Exit For
Next
Application.ReferenceStyle = xlA1
GetCellColor = myColor
End Function