Sammentæl kollone vha farvekode

Denne funktion kan sammentælle celler med samme tekstfarve.

Ulempen er at den ikke opdateres automatisk, da en ændring af fontfarven ikke trikker funktionen.

Function ColorCount(rRange As Range, FColor As Range) As Double
Dim rCell As Range
Dim dCount As Double
dCount = 0
    Application.Volatile
    For Each rCell In rRange
        If rCell.Font.Color = FColor.Font.Color Then
            dCount = dCount + rCell
        End If
    Next rCell
    ColorCount = dCount
End Function

Jeg er ikke SÅ hård til VB.... - rent faktisk kan jeg ikke gennemskue din funktion....!?
Mine cellerange ligger i "G6:G39" og jeg tvivler på at jeg kan få den til at køre som en ordentlig makro....

Kan du hjælpe med at indsætte den i din funktion...?

Funktionen skal ligge i et modul.

I excel trykker du ALT +F11
Nu er du i kode modulet

Vælg insert module

Her skal denne kode sættes ind


Function ColorCount(rRange As Range, FColor As Range) As Double
Dim rCell As Range
Dim dCount As Double
dCount = 0
    Application.Volatile
    For Each rCell In rRange
        If rCell.Font.Color = FColor.Font.Color Then
            dCount = dCount + rCell
        End If
    Next rCell
    ColorCount = dCount
End Function



rRange er det område den skal sæammentælle

FColor er en celle med samme skriftfarve, som dem den skal finde

Den kaldes med
=ColorCount(G6:G39;A1)

i dette eksempel er det A1 der kar den skriftfarve der skal sammentælles.

Jeg er lige blevet i tvivl, om du vil sammentælle eller bare vide antallet af celler, der har den farve.

hvis den kun skal tælle.

ret
dCount = dCount + rCell
til
  dCount = dCount + 1

Hej kabbak,

Det ER meningen den blot skal sammentælle den angivende kollonne, så det er helt fint men jeg glemte at sammentællingen skulle kunne ses i celle "G41".

Jeg ved ikke rigtig om jer er dum eller særdeles uvidende i programmering men jeg vil gerne sammenkoble den med makroen i celle "G41"....!?

xxxxxxx
Sub Makro2()
'
' Makro2 Makro
' Makro indspillet 29-07-2005 af hbs
'

'
    Range("G41").Select
   
    End Sub
_________________________________________________________________
Function ColorCount As Range, FColor As Range) As Double
Dim rCell As Range
Dim dCount As Double
dCount = 0
    Application.Volatile
    For Each rCell In rRange
        If rCell.Font.Color = FColor.Font.Color Then
            dCount = dCount + 1
        End If
    Next rCell
    ColorCount = ColorCount(G6:G39;A1) = dCount
End Function

Sub Makro2()
'
' Makro2 Makro
' Makro indspillet 29-07-2005 af hbs
    Range("G41").Select
    Range("G41") = ColorCount(Range("G6:G39"), Range("A1"))
                        ' ret "A1" til en celle der har den skriftfarve der skal tælles
    End Sub
Function ColorCount(rRange As Range, FColor As Range) As Double

Dim rCell As Range
Dim dCount As Double
dCount = 0
    Application.Volatile
    For Each rCell In rRange
        If rCell.Font.Color = FColor.Font.Color Then
            dCount = dCount + 1
        End If
    Next rCell
    ColorCount = dCount
End Function


Når du så kører makroen, vil celle "G41" opdateres

Du er f... en guttermand.... - det virker perfekt.
Tak for hjælpen.

Ville ønske jeg havde sat 200p af.

Tak

Arh... - hvordan f... får du nu de point.... shit... jeg var for ivrig!!!!

kabak... du fortjener dem. Hvordan kan du få dem..?

lav et nyt spørgsmål i denne katogori.

Titel = point til kabbak

sæt et link pø til dette spørgsmål

kabbak