Excel Farbige Zellen summieren

Dieses Thema Excel Farbige Zellen summieren im Forum "Microsoft Office Suite" wurde erstellt von NONameMG, 23. Juni 2004.

Thema: Excel Farbige Zellen summieren Moin, es sind jetzt wohl mal alle VBA'ler gefragt ;D Wie bekomme eine Funktion oder Modul das mir 1....

  1. Moin,
    es sind jetzt wohl mal alle VBA'ler gefragt ;D
    Wie bekomme eine Funktion oder Modul das mir
    1. Unterschiedliche Farben in Zellen erkennt
    2. und diese je nach Farbe summiert und als Zahlenwert ausgibt 8)

    BItte nicht nach den Sinn fragen, war nicht meine Idee..ist nur aktuell bie meiner Work ;D ;D
     
  2. Ola,

    schau mal in den hinteren Teil des Forums, wir hatten eine solche Frage schon mal vor längerer Zeit. Eventuell die Suchfunktion des Forums nutezn ...
     
  3. Hi NoNameMG,

    hab dir ein Beispielmakro erstellt.

    Gruß Matjes :)

    Code:
    Option Explicit
    Option Base 1
    Private Type f_rec
      FarbIndex As Integer
      Summe As Double
    End Type
    
    Sub FarbigeZellenSummieren()
    '*** bildet die Summe über die numerischen Werte
    '*** aller farbigen Zellen pro Farbe und
    '*** gibt das Ergebnis auf einem temp. Arbeitsblatt aus.
    '*** (nicht betrachtet werden Zellen, die den Colorindex
    '*** xlColorIndexNone oder xlColorIndexAutomatic haben)
      Dim f() As f_rec, f_cnt As Integer, f_ind As Integer
      Dim Zelle As Range, Blattname As String, ws As Worksheet
      Dim i_Farbe As Integer, d_Wert As Double, i As Integer
      Dim z As Long
      ReDim f(1 To 1)
      f_cnt = 0
      
     ->den benutzten Bereich des aktiven Blattes selektieren
      ActiveSheet.UsedRange.Select
      
     ->alle selektierten Zellen nacheinander bearbeiten
      For Each Zelle In Selection
        
       ->Zelle farbig ?
        i_Farbe = Zelle.Interior.ColorIndex
        If (i_Farbe <> xlColorIndexNone) And _
          (i_Farbe <> xlColorIndexAutomatic) Then
          
         ->Wert der Zelle numerisch
          If IsNumeric(Zelle.Value) Then
            d_Wert = Zelle.Value
            
           ->Farbe schon gemerkt
            f_ind = 0
            For i = 1 To f_cnt
              If f(i).FarbIndex = i_Farbe Then
                f_ind = 1
                Exit For
              End If
            Next
            If f_ind = 0 Then
             ->Farbe noch nicht gemerkt
             ->-> Farbe merken, Wert aufsummieren
              f_cnt = f_cnt + 1
              ReDim Preserve f(1 To f_cnt)
              f(f_cnt).FarbIndex = i_Farbe
              f(f_cnt).Summe = d_Wert
            Else
             ->Farbe bereits gemerkt
             ->-> Wert aufsummieren
              f(f_ind).Summe = f(f_ind).Summe + d_Wert
            End If
          End If
        End If
      Next
      ActiveSheet.Cells(1, 1).Select
      
     ->keine Werte gezählt -> Ende
      If f_cnt = 0 Then Exit Sub
      
     ->Ergebnis auf einem temporären Blatt ausgeben
      Blattname = ActiveSheet.Name
      Set ws = ActiveWorkbook.Worksheets.Add
      z = 1
      ws.Cells(z, 1).Value = Summen nach Farben
      ws.Cells(z, 1).Font.Bold = True
      z = z + 1
      ws.Cells(z, 1).Value = Blatt:  & Blattname
      ws.Cells(z, 1).Font.Bold = True
      For i = 1 To f_cnt
        z = z + 1
        ws.Cells(z, 1).Value = f(i).Summe
        ws.Cells(z, 1).Interior.ColorIndex = f(i).FarbIndex
      Next
      ws.Name = tmpErG_ & Format(Now(), yymmdd_hhnnss)
      Set ws = Nothing
    End Sub
    
     
  4. Moin Majes,
    thx thx...ich probier es gleich mal aus...

    :)

    Gruß Mario
     
Die Seite wird geladen...

Excel Farbige Zellen summieren - Ähnliche Themen

Forum Datum
Excel-Feature gesucht Microsoft Office Suite 11. Okt. 2016
Excel Tabelle Werte zu ordnen Microsoft Office Suite 23. Sep. 2016
Excel: Bereiche auf 'leer' Überprüfen Microsoft Office Suite 15. Sep. 2016
Import Datensatz inkl = und - Zeichen in Excel/Libre CALC Software: Empfehlungen, Gesuche & Problemlösungen 20. Mai 2016
Bestimmter User kann seine Excel Dateien nicht mehr direkt öffnen Software: Empfehlungen, Gesuche & Problemlösungen 16. Apr. 2016