Supportnet Computer
Planet of Tech

Supportnet / Forum / Tabellenkalkulation

Makro das farbige Zellen in eine Reihenfolge sortiert





Frage

Hallo ich glaube ich habe ein etwas anspruchvolles Problem. Vielleicht kann mir da jemand helfen. Ich habe drei Spalten bedingt formatiert. Je nach Farbkombination sollten sich die Zeilen sortieren. Dreimal rot wäre Platz 1, zweimal rot und einmal gelb wäre Platz 2. usw. Bis dreimal grün dann auf dem letzten Platz stehen würde. In diesen Bereich auf den das Makro zugreift sollte man auch Zeilen einfügen können und das Makro sollte sich dynamisch anpassen. Vielen Dank im Vorraus

Antwort 1 von Hajo_Zi

Hallo ??,

http://www.herber.de/bbs/texte/8colorsort.xls

Gruß Hajo
  • Zitat:
    *Eigenwerbung Gelöscht*
    Admininfo: siehe die SN Nutzungsbedingungen.


  • Antwort 2 von Hajo_Zi

    Hallo ??,

    mir ist jetzt erst aufgefallen das Du es mit bedingter Formatierung geacht hast. Da geht das Beispiel wohl nicht.
    Die bedingte Formatierung auslesen ist das komplizierteste was mir bekannt ist.

    Gruß Hajo
  • Zitat:
    *Eigenwerbung Gelöscht*
    Admininfo: siehe die SN Nutzungsbedingungen.


  • Antwort 3 von nighty

    hi all :)

    auf die schnelle hab wenig zeit
    daher mit hilfsspalte noch
    in der die erste funktion sein sollte die dann sortiert werden koennte nach dem farbindex

    gruss nighty

    Function BedingungAdd(Zellen As Range) As Double
    BedingungAdd = GetCellColor(Zellen)
    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

    Ich möchte kostenlos eine Frage an die Mitglieder stellen:


    Ähnliche Themen:


    Suche in allen vorhandenen Beiträgen: