Count colors in excel VBA

Status
Niet open voor verdere reacties.

simal

Gebruiker
Lid geworden
18 aug 2004
Berichten
18
Hallo,
In een msg box krijg ik het het aantal van elke achergrondkleur in de geselecteerde cellen .
Dit aantal kan regelmatig veranderen.
Welke is de code die de resultaten in de msgbox zou kunnen copiëren naar een ander werkblad in hetzelfde workbook?
Zou iemand kunnen helpen?
 
Hallo,
In een msg box krijg ik het het aantal van elke achergrondkleur in de geselecteerde cellen .
Dit aantal kan regelmatig veranderen.
Welke is de code die de resultaten in de msgbox zou kunnen copiëren naar een ander werkblad in hetzelfde workbook?
Zou iemand kunnen helpen?

Wat komt er nu precies te staan in de msgboxen?
 
count colors in, excell vba

goeie morgen,
dit is een deel van de code:
msg = y & " Gereserveerd"
msg = msg & vbCrLf & g & " genodigden"
msg = msg & vbCrLf & r & " Betaald"
msg = msg & vbCrLf & t & " Leden"
msg = msg & vbCrLf & v & " Groep"
msg = msg & vbCrLf & l & " Niet Bezet"
msg = msg & vbCrLf & oth & " Other"
msg = msg & vbCrLf & "Total: " & selection.Count

MsgBox (msg)
 
Bijvoorbeeld:

Code:
Sheets("naamvandesheet").Range("adresvandecel").Value = "Er zijn " & g & " genodigden."

Wigi
 
count colors in excel

Wigi,
Sorry ik ben niet zo'n guru. Ik kom er niet uit.
Hierbij de gehele code waarbij ik dus eerst alle cellen selecteer met een andere button(macro) en de " optel"btn geeft dan het resultaat.
Dat resultaat komt dan in die msg box die ik zo niet kan kopieren.Maar ik wens die resultaten ook automatisch in een andere sheet te zetten. Zo te zien kan ik dat enkel door overschrijven waarbij fouten kunnen overgeschreven worden natuurlijk.
Hier de code :


Private Sub BtnCountColors4_Click()
Call CountColors
End Sub
Sub CountColors()

y = 0
g = 0
r = 0
t = 0
v = 0
l = 0
oth = 0

For Each cell In selection
Select Case cell.Interior.ColorIndex
Case 27 'yellow
y = y + 1
Case 4 'green
g = g + 1
Case 3 'red
r = r + 1
Case 8 'turquoise
t = t + 1
Case 26 'violet
v = v + 1
Case 35 'light green
l = l + 1
Case Else
oth = oth + 1
End Select
Next cell

msg = y & " Gereserveerd"
msg = msg & vbCrLf & g & " genodigden"
msg = msg & vbCrLf & r & " Betaald"
msg = msg & vbCrLf & t & " Leden"
msg = msg & vbCrLf & v & " Groep"
msg = msg & vbCrLf & l & " Niet Bezet"
msg = msg & vbCrLf & oth & " Other"
msg = msg & vbCrLf & "Total: " & selection.Count

MsgBox (msg)

End Sub




Function SUMIFCOLOUR(TheRange As Range, TheColourCell As Range) As Variant

Dim TempRange As Range
Dim Result
Dim Colour

Application.Volatile
On Error GoTo BailOut
Colour = TheColourCell.Interior.Color

For Each TempRange In TheRange
If Colour = TempRange.Interior.Color Then Result = Result + TempRange.Value
Next

BailOut:
SUMIFCOLOUR = Result

End Function

Function COUNTIFCOLOUR(TheRange As Range, TheColourCell As Range) As Variant

Dim TempRange As Range
Dim Result
Dim Colour

Application.Volatile
On Error GoTo BailOut
Colour = TheColourCell.Interior.Color

For Each TempRange In TheRange
If Colour = TempRange.Interior.Color Then Result = Result + 1
Next

BailOut:
COUNTIFCOLOUR = Result

End Function


Hopelijk kun je er iets mee aanvangen ?

Dank
Simal
 
In plaats van:

Code:
msg = y & " Gereserveerd"
msg = msg & vbCrLf & g & " genodigden"
msg = msg & vbCrLf & r & " Betaald"
msg = msg & vbCrLf & t & " Leden"
msg = msg & vbCrLf & v & " Groep"
msg = msg & vbCrLf & l & " Niet Bezet"
msg = msg & vbCrLf & oth & " Other"
msg = msg & vbCrLf & "Total: " & selection.Count

MsgBox (msg)

zet je:

Code:
Sheets("NaamVanDeSheetWaarJeAantalGenodigdenWilHebben").Range("AdresVanDeCelWaarJeAantalGenodigdenWilHebben").Value = "Er zijn " & g & " genodigden."
Sheets("NaamVanDeSheetWaarJeAantalBetaaldWilHebben").Range("AdresVanDeCelWaarJeAantalBetaaldWilHebben").Value = "Er heben er " & r & " Betaald."
'rest van de code

Bijvoorbeeld:

Code:
Sheets("Blad1").Range("A1").Value = "Er zijn " & g & " genodigden."
Sheets("Blad1").Range("A2").Value = "Er heben er " & r & " Betaald."
'rest van de code

Wigi
 
Kan je in het vervolg ook code tags gebruiken als je code hier plaatst? Dat doe je door de code te selecteren en dan op het # symbooltje te klikken. Bedankt.

Wigi
 
Graag gedaan. Kan je de vraag nog even op opgelost zetten aub?
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan