Black Friday = Pricewatch Bekijk onze selectie van de beste Black Friday-deals en voorkom een miskoop.

[Excel 2016] Gekleurde vakken tellen

Pagina: 1
Acties:

  • TripleZ
  • Registratie: Mei 2010
  • Laatst online: 28-12-2024
Ik heb de code van het volgende artikel gebruikt: https://www.ablebits.com/...count-sum-by-color-excel/

Ik heb de formule gebruikt van het kopje 'How to count by color and sum by color in an Excel worksheet'.

code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
Function GetCellColor(xlRange As Range)
    Dim indRow, indColumn As Long
    Dim arResults()
 
    Application.Volatile
 
    If xlRange Is Nothing Then
        Set xlRange = Application.ThisCell
    End If
 
    If xlRange.Count > 1 Then
      ReDim arResults(1 To xlRange.Rows.Count, 1 To xlRange.Columns.Count)
       For indRow = 1 To xlRange.Rows.Count
         For indColumn = 1 To xlRange.Columns.Count
           arResults(indRow, indColumn) = xlRange(indRow, indColumn).Interior.Color
         Next
       Next
     GetCellColor = arResults
    Else
     GetCellColor = xlRange.Interior.Color
    End If
End Function
 
Function GetCellFontColor(xlRange As Range)
    Dim indRow, indColumn As Long
    Dim arResults()
 
    Application.Volatile
 
    If xlRange Is Nothing Then
        Set xlRange = Application.ThisCell
    End If
 
    If xlRange.Count > 1 Then
      ReDim arResults(1 To xlRange.Rows.Count, 1 To xlRange.Columns.Count)
       For indRow = 1 To xlRange.Rows.Count
         For indColumn = 1 To xlRange.Columns.Count
           arResults(indRow, indColumn) = xlRange(indRow, indColumn).Font.Color
         Next
       Next
     GetCellFontColor = arResults
    Else
     GetCellFontColor = xlRange.Font.Color
    End If
 
End Function
 
Function CountCellsByColor(rData As Range, cellRefColor As Range) As Long
    Dim indRefColor As Long
    Dim cellCurrent As Range
    Dim cntRes As Long
 
    Application.Volatile
    cntRes = 0
    indRefColor = cellRefColor.Cells(1, 1).Interior.Color
    For Each cellCurrent In rData
        If indRefColor = cellCurrent.Interior.Color Then
            cntRes = cntRes + 1
        End If
    Next cellCurrent
 
    CountCellsByColor = cntRes
End Function
 
Function SumCellsByColor(rData As Range, cellRefColor As Range)
    Dim indRefColor As Long
    Dim cellCurrent As Range
    Dim sumRes
 
    Application.Volatile
    sumRes = 0
    indRefColor = cellRefColor.Cells(1, 1).Interior.Color
    For Each cellCurrent In rData
        If indRefColor = cellCurrent.Interior.Color Then
            sumRes = WorksheetFunction.Sum(cellCurrent, sumRes)
        End If
    Next cellCurrent
 
    SumCellsByColor = sumRes
End Function
 
Function CountCellsByFontColor(rData As Range, cellRefColor As Range) As Long
    Dim indRefColor As Long
    Dim cellCurrent As Range
    Dim cntRes As Long
 
    Application.Volatile
    cntRes = 0
    indRefColor = cellRefColor.Cells(1, 1).Font.Color
    For Each cellCurrent In rData
        If indRefColor = cellCurrent.Font.Color Then
            cntRes = cntRes + 1
        End If
    Next cellCurrent
 
    CountCellsByFontColor = cntRes
End Function
 
Function SumCellsByFontColor(rData As Range, cellRefColor As Range)
    Dim indRefColor As Long
    Dim cellCurrent As Range
    Dim sumRes
 
    Application.Volatile
    sumRes = 0
    indRefColor = cellRefColor.Cells(1, 1).Font.Color
    For Each cellCurrent In rData
        If indRefColor = cellCurrent.Font.Color Then
            sumRes = WorksheetFunction.Sum(cellCurrent, sumRes)
        End If
    Next cellCurrent
 
    SumCellsByFontColor = sumRes
End Function


De formule werkt gewoon. Ik heb het toegevoegd in de module van VBA. Ik sla het vervolgens op als .xlsm (als excelbestand met macro). Voor het sluiten van het bestand zie ik gewoon het resultaat staan van de kleurtelling. Na het openen van het Excelbestand niet meer. Als als ik een nieuwe formule van '.CountCellsByColor' of 'SumCellsByColor' intyp lukt het niet meer. De uitkomsten worden na het heropenen van het Excelbestand vermeld als #NAAM?

De code van The_Vice heb ik geprobeerd, maar dit lukt niet: [Excel] Waardes van gekleurde tekst in cellen optellen

  • Chief
  • Registratie: Januari 2009
  • Laatst online: 14-11 01:56
Heeeeel misschien: als je Excel opent, staat het toe dat het macro's uitvoert?

Ik kwam, ik zag, ik ging er keihard vandoor


  • breew
  • Registratie: April 2014
  • Laatst online: 07:43
In welk project staat de module?

Probeer eens om de module op te slaan in je personal.xlsb

  • breew
  • Registratie: April 2014
  • Laatst online: 07:43
@TripleZ: Gaat het weer goed zodra je op F9 hebt gedrukt?

Voeg deze code eens toe aan je workbook:
Visual Basic:
1
2
3
Private Sub Workbook_Open()
  Application.SendKeys "{F9}"
End Sub


Visual Basic:
1
2
3
Private Sub Workbook_Open()
  Application.Calculate
End Sub
Zou theoretisch ook moeten werken, maar doet dat (blijkbaar?) niet in alle gevallen...
Er schijnen vaker dergelijke problemen te zijn met het berekenen van achtergrondkleuren door een macro/functie.

  • TripleZ
  • Registratie: Mei 2010
  • Laatst online: 28-12-2024
Chief schreef op vrijdag 12 januari 2018 @ 06:07:
Heeeeel misschien: als je Excel opent, staat het toe dat het macro's uitvoert?
Dit heeft geholpen. Het bleek, dat ik macro's uit had staan, behalve die digitaal zijn ondertekend. Nu heb ik dus alle macro's ingeschakeld.

Ik heb de formules CountCellsByColor and CountCellsByFontColor gecontroleerd en ze werken beide.

Ik heb geen enkele ervaring in VBA of programmeren. Dat wil ik nog vermelden. Het enige wat ik eerder had gedaan is simpelweg de code kopiëren.

Ik heb nog de twee codes van de F9 ingevoerd. Ik heb ze geplaatst in VBA in ThisWorkBook. Ik hoop, dat dit de juiste plek was. Ik drukte op F9 en de formules werden opnieuw berekend. Het is dus hetzelfde als de functie 'bereken now'.

Bedankt beide voor de hulp.