Werte zusammenrechnen in Abhängigkeit von ihrer Farbe

Dieses Thema Werte zusammenrechnen in Abhängigkeit von ihrer Farbe im Forum "Microsoft Office Suite" wurde erstellt von nok106, 5. Sep. 2006.

Thema: Werte zusammenrechnen in Abhängigkeit von ihrer Farbe Hallo Leute, wenn ich mit dem Code Farbwerte addiere, klappt es mit jeder Farbnummer, nur mit  Farbe Schwarz - Nr.1...

  1. Hallo Leute,

    wenn ich mit dem Code Farbwerte addiere, klappt es mit jeder Farbnummer, nur mit  Farbe Schwarz - Nr.1 bekomme ich ein Fehlermeldung.

    Hat jemand eine Idee wo dran es liegen könnte und wenn ja- wo ???

    Code:
    Option Explicit
    Function Farbsumme(Bereich As Range, Farbe As Long) ->Schriftfarbe
    Dim Zelle As Range
    For Each Zelle In Bereich
    If Zelle.Font.ColorIndex = Farbe Then
    Farbsumme = Farbsumme + Zelle.Value
    End If
    Next
    End Function
    

    Gruß

    Odje
     
  2. Hallo nok106,

    was bekommst du denn für einen Fehler ? (Nummer und Text)

    Gruß Matjes :)

    ps: Zelle ist eine Objekt-Variable, die sollte am Ende wieder Freigegeben werden.
    Code:
    Function Farbsumme(Bereich As Range, Farbe As Long) ->Schriftfarbe
      
      Dim Zelle As Range
      
      For Each Zelle In Bereich
        If Zelle.Font.ColorIndex = Farbe Then
          Farbsumme = Farbsumme + Zelle.Value
        End If
      Next
      
      Set Zelle = Nothing
    End Function
     
  3. Hi Matjes,

    sorry,
    Fehlermeldung ist nicht der richtige Ausdruck !

    In der Ergebnis-Zelle erscheint nur eine Null.
    Eingabe A10 =farbsumme(A1:A9;1) Ergebnis = 0

    Gruß

    Odje
     
  4. Hallo nok106,

    dann probier mal die folgende Funktion aus. Die sollte dir sagen, wenn etwas Ungewöhnliches bei der Addition auftritt.

    Gruß Matjes :)
    Code:
    Function Farbsumme(Bereich As Range, Farbe As Long) As Double->Schriftfarbe
     
     Dim Zelle As Range, dWert As Double, dFarbsummeVorher As Double
     Dim sString As String, s As String, bIstNull As Boolean, x As Long
     
     On Error Resume Next
     For Each Zelle In Bereich
      If Zelle.Font.ColorIndex = Farbe Then
       If Zelle.Value <>  Then
        dFarbsummeVorher = Farbsumme
        dWert = Zelle.Value
        If Err.Number <> 0 Then
         MsgBox _
          Farbsumme: Wert-> & Zelle.Value &-> ist keine Zahl & vbLf & _
          Adresse:  & Zelle.Address(False, False)
        End If
        Farbsumme = Farbsumme + dWert
        If Farbsumme = dFarbsummeVorher Then
         sString = Zelle.Value
         bIstNull = True
         For x = 1 To Len(sString)
          s = Mid(sString, x, 1)
          Select Case s
           Case 0
           Case ,: If x <> 2 Then bIstNull = False
           Case Else: bIstNull = False
          End Select
         Next
         If Not bIstNull Then
          MsgBox _
           Farbsumme: Wert-> & Zelle.Value &-> läßt Summe unverändert. & vbLf & _
           Adresse:  & Zelle.Address(False, False)
         End If
        End If
       End If
      End If
     Next
     On Error GoTo 0
     Set Zelle = Nothing
    End Function
     
  5. Hallo Matjes,

    mit dem Code das gleiche Problem. Ergebnis = 0.

    Habe mal die folgende Function eingegeben, diese zählt die Zellen mit gleicher Hintergrundfarbe zusammen:

    Eingabe: =fz(A1:A10;1) - da wird das Ergebnis exakt mit der Summe 10 ausgerechnet.

    Code:
    Function FZ(Bereich As Range, Farbe As Long) As Double->Hintergrund
    Dim Zelle As Range
    For Each Zelle In Bereich
    If Zelle.Interior.ColorIndex = Farbe Then
    FZ = FZ + 1
    End If
    Next
    End Function
    Könnte es sein, dass für die Schriftfarbe Schwarz eine andere Farbindex-Nummer besteht ?

    Gruß

    Odje
     
  6. Hallo nok106 ,

    jetzt kommen wir dem Rätsel auf die Spur  ;D

    Wenn die Farbe der Zeichen innerhalb der Zelle nicht einheitlich ist, liefert Zelle.Font.Colorindex  Null (nicht zu verwechseln mit 0), bedeutet: Kann den Colorindex nicht bestimmen.

    Die folgende Variante gibt dir den Farbensalat als Meldung aus  ;D

    Gruß Matjes :)
    Code:
    Function Farbsumme(Bereich As Range, Farbe As Long) As Double ->Schriftfarbe
      
      Dim Zelle As Range, x As Long, s As String
      
      For Each Zelle In Bereich
        With Zelle
          If IsNull(.Font.ColorIndex) Then
            s = Zeichen in  & Zelle.Address(False, False) &  =  & Zelle.Value & vbLf
            For x = 1 To Zelle.Characters.Count
              s = s & x & . Zeichen Colorindex =  & .Characters(Start:=x, Length:=1).Font.ColorIndex & vbLf
            Next
            MsgBox _
              Font-Colorindex ist gemischt. & vbLf & s & vbLf & vbLf & _
              Diese Zahl wird zu keinem Colorindex addiert :-(
          ElseIf .Font.ColorIndex = Farbe Then
            Farbsumme = Farbsumme + Zelle.Value
          End If
        End With
      Next
      
      Set Zelle = Nothing
    End Function
     
  7. Hallo Matjes,

    vorweg besten Dank für deine Bemühungen.

    Das Problem ist gelöst.

    Habe ein kleines Programm erstellt:

    Code:
    Option Explicit
    Sub SchriftFarbe()
    MsgBox Die aktive Zelle   & ActiveCell.Address & _
      hat den Schriftfarbenindex  & ActiveCell.Font.ColorIndex
    End Sub
    Damit habe ich die Schriftfarben ausgelesen und folgendes festgestellt.

    Wenn man in einer Exceltabelle Eingaben macht, geschieht es nicht mit der Farbe Schwarz sondern mit der Farbe (Schwarz-Automatisch) und die hat den Schriftfarbenindex -4105 und nicht wie ich angenommen habe die Farbe Schwarz.

    Wenn ich rechne, =farbsumme(A1:A10;-4105) erscheint ein richtiges Ergebnis, formatiere ich die Zahlenkollonne mit der Farbe Schwarz und rechne, =farbsumme(A1:A10;1) erscheint auch das richtige Ergebnis.

    Auch die Zellen-Hintergrundfarbe hat nicht den Farbindex 2 (Weiss) sondern die Farbnummer -4142.

    Somit ist mein vermutlicher Rechenfehler aufgeklärt und ich habe wieder dazugelernt.  ;D

    Bis zum nächsten Mal.

    Gruß

    Odje
     
Die Seite wird geladen...

Werte zusammenrechnen in Abhängigkeit von ihrer Farbe - Ähnliche Themen

Forum Datum
Excel Tabelle Werte zu ordnen Microsoft Office Suite 23. Sep. 2016
Lüftersteuerungsprogramme finden keine Werte/funktionieren nicht Windows 8 Forum 28. Juli 2015
Abspeichern von Registry Werten Windows XP Forum 25. Okt. 2011
Windows-Leistungsindex Werte Windows 7 Forum 9. Dez. 2010
ReadyBoost, wie die von Windows gemessenen Geschwindigkeitswerte auslesen? Windows 7 Forum 17. Aug. 2010