Tæl indhold i farvet celler i excel

Hej jetpet88

- Må det være med en makro (VBA kode) ?
- Hvornår har du tænkt dig at sammetællingen skal ske ?
- Har du et område hvori de farvede celler er ?

Med venlig hilsen, Nicolai

Hej Nicolai.

Marco (VMA kode)? Er det der hvor man selv skal oprettet koden? For så ja. Det har jeg fundet ud af.

Sammentællingen skal ske som det sidste i arket. Altså hvis du har en masse tal fra eks. hele 2011 og du så vil finde ud af at hvad alle de celler der er røde giver til sammen, det samme med blå og grøn hvordan gør man så det. Området kan eks. hedde B4 - B54

Hej jetpet88

Vil sammentællingen kunne starte via en knap på selve Excelarket ??

Med venlig hilsen, Nicolai

Hmm.. Hvis der er en knap der kan det??? Men ellers så en kode som eks =Hvis( ...

Hvad farver cellerne? - er det betinget formatering.

Hvis JA - brug samme kriterier for sammentællingen.

Er der tale om manuel farvning af celler, er der ingen vej uden om en VBA-løsning.

Det er nogle celler der er manuelt farvet.

Hej jetpet88

Jeg vender lige tilbage efter 8 i aften.

Med venlig hilsen, Nicolai

Prøve evt. denne VBA kode med din egen Funktion. Denne kan lægge celler sammen med baggrund eller tekst i Rød, Blå og Grøn:

Function TÆL_FARVER(ByVal Farve As String, ByRef Område As Range) As Double

Const RødBaggrund = 255
Const GrønBaggrund = 5287936
Const BlåBaggrund = 12611584
Const RødTekst = 255
Const GrønTekst = 5287936
Const BlåTekst = 12611584

Dim SUM_C As Double

Dim MySelection As Integer

On Error GoTo ErrorHandler

    Select Case Farve
   
        Case "RødBaggrund"
       
            InteriorColor = RødBaggrund
            MySelection = 1
                       
        Case "GrønBaggrund"
       
            InteriorColor = GrønBaggrund
            MySelection = 1
                       
        Case "BlåBaggrund"
       
            InteriorColor = BlåBaggrund
            MySelection = 1
           
        Case "RødTekst"
       
            InteriorColor = RødTekst
            MySelection = 2
                       
        Case "GrønTekst"
       
            InteriorColor = GrønTekst
            MySelection = 2
                       
        Case "BlåTekst"
       
            InteriorColor = BlåTekst
            MySelection = 2
                       
    End Select
   
    SUM_C = 0
   
    If MySelection = 1 Then
   
        For Each c In Område
   
            If c.Interior.Color = InteriorColor Then SUM_C = SUM_C + c.Value
   
        Next c

   
    ElseIf MySelection = 2 Then
   
        For Each c In Område
   
            If c.Font.Color = InteriorColor Then SUM_C = SUM_C + c.Value
   
        Next c

    End If
   
   
   
    TÆL_FARVER = SUM_C

Exit Function

ErrorHandler:

    MsgBox ("Du kan søge på Celler med {'RødBaggrund', 'RødTekst', 'GrønBaggrund', 'GrønTekst', 'BlåBagrund', 'BlåTekst'}")


End Function

en gammel en fra bak's tid
Lav en celle med den baggrundsfarve, som skal summeres (rColor)
området (rRange)

Public Function ColorSum(rRange As Range, rColor As Range) As Double
    Dim rCell As Range
    Dim dCount As Double
    dCount = 0
    Application.Volatile
    For Each rCell In rRange
        If rCell.Interior.ColorIndex = rColor.Interior.ColorIndex Then
            dCount = dCount + rCell
        End If
    Next rCell
    ColorSum = dCount
End Function

Hej jetpet88

Følgende kode fungerer hos undertegnede i Excel 2003.
Jeg har oprettet en knap (cmdTælFarvedeCeller) på arket "Sheet1".

Koden løber gennem cellerne B4 til B54 og kigger efter 5 farver.
Værdierne i de farvede celler tælles op i hver sin celle, fra D1 til D5 ... og resultatet skrives med den aktuelle font farve.

Antallet af farver kan tilpasses ved af udvide/begrænse select Case strukturen.

Området der løbes igennem kan let tilrettes ved at ændre start og stop for lRow og lCol.

Det kan godt være, at du selv skal tilrette ColerIndex farvekoderne, så de passer til din baggrundsfarver ?

Her er et link til ColerIndex farvekoderne:
http://vbadud.blogspot.com/2007/06/colorindex-coloring-excel-sheet-cells.html


Prøv det og lad høre ...


Private Sub cmdTælFarvedeCeller_Click()
Dim lRow As Long
Dim lCol As Long
Dim farve As Integer
   
   
'sæt font farve i de opsummerede celler
Sheet1.Range("D1").Font.ColorIndex = 3  'rød
Sheet1.Range("D2").Font.ColorIndex = 4  'grøn
Sheet1.Range("D3").Font.ColorIndex = 5  'blå
Sheet1.Range("D4").Font.ColorIndex = 6  'gul
Sheet1.Range("D5").Font.ColorIndex = 7  'pink
   
   
'deaktiver skærmopdatering
Application.ScreenUpdating = False


    'fra række 4 til 54
    For lRow = 4 To 54
   
        'fra kolonne B til B
        For lCol = 2 To 2
       
            'tildel farve det aktuelle colorindex
            farve = Sheet1.Cells(lRow, lCol).Interior.ColorIndex
           
                'vælg farven der skal opsummeres
                Select Case farve

                    'rød = 3
                    Case 3

                        'opsummer celle D1
                        Sheet1.Range("D1").Value = Sheet1.Range("D1").Value + Cells(lRow, lCol).Value
                                             
                    'grøn = 4
                    Case 4
                       
                        'opsummer celle D2
                        Sheet1.Range("D2").Value = Sheet1.Range("D2").Value + Cells(lRow, lCol).Value
                                               
                    'blå = 5
                    Case 5
                       
                        'opsummer celle D3
                        Sheet1.Range("D3").Value = Sheet1.Range("D3").Value + Cells(lRow, lCol).Value
                                               
                    'gul = 6
                    Case 6

                        'opsummer celle D4
                        Sheet1.Range("D4").Value = Sheet1.Range("D4").Value + Cells(lRow, lCol).Value
                       
                    'pink = 7
                    Case 7
                       
                        'opsummer celle D5
                        Sheet1.Range("D5").Value = Sheet1.Range("D5").Value + Cells(lRow, lCol).Value
                       
                       
                End Select

        'næste kolonne
        Next lCol
   
    'næste række
    Next lRow
   
 

'aktiver skærmopdatering
Application.ScreenUpdating = True

End Sub


Med venlig hilsen, Nicolai

http://gupl.dk/672046/

Hej Alle.

Jeg takker for hjælpen og Kabbak og store-morten har kommet med de enkelste svar (for mig). Men takker jer alle.

Kabbak eller store-morten er der en af jer der vil sætte et svar på så jeg kan give jer point? Takker :)

Velbekomme.
Husk, vent på 'Svar' fra kabbak og del.

ok ;-))