Colorier des cellules et les compter

re bonjour,
encore moi alors je repasse juste pour reexpliquer proprement dsl pour le premier jet

alors en tout premier lieu on oublie la mise en couleur de cellule identique qui apres definition de mes besoins ne va pas me servir mais d apres ce que j ai vu sur le net personne n a vraiment une solution qui marche a 100

ensuite j ai une liste de 5829 lignes avec des noms qui reviennent souvent je voudrais si possible :

- qu excel compare toute les cellules et comptes les cellules avec des noms identiques dans une colone et qu il m affiche le resultat

un extrait de mon tableau http://www.cijoint.fr/cjlink.php?file=cj200910/cij8VtlIWJ.xls

donc ce que j aimerez c est pouvoir le faire avec les nom de la colone J et avec les chiffres aussi
meme si pour cela on peut avoir plusieur script different

pour le moment pour les nom j ai ca

Sub ValeursIdentiques()
Dim N2 As Object, vRésultat As Long

For Each N1 In Range("j2:j5829")

If N1 = "Scannit Remote" Then

vRésultat = vRésultat + N1.Count
End If
Next N1
Range("N2") = vRésultat

Dim N3 As Object, bRésultat As Long

For Each N1 In Range("j2:j5829")

If N1 = "PremVet Remote" Then

vRésultat = vRésultat + N1.Count
End If
Next N1
Range("N3") = vRésultat

End Sub

on peut le copier a linfini en changeant deux trois trux comme les noms mais ce qui serait bien c est que ce soit exel qui s en charge tout seul et qu il compte tout seul

voila voila

Bonsoir,

C'est un peu le B... tes explications :-)
Enfin si j'ai compris,essaies ceci

Sub denombrer()
Dim coll As Collection
Dim derlig As Long

derlig = Range("J65536").End(3).Row

'recherche les noms différents dans la col J
Set coll = New Collection
For cptr = 2 To derlig
On Error Resume Next
coll.Add Cells(cptr, 10).Value, CStr(Cells(cptr, 10).Value)
Next

Application.ScreenUpdating = False
'nettoie la zone de restitution
Range("N1:O" & derlig).ClearContents

'restitue en col  N les noms et en col O le nombre d'occurences
For cptr = 1 To coll.Count
Cells(cptr + 1, 14) = coll(cptr)
Cells(cptr + 1, 15) = Application.CountIf(Range("J2:J" & derlig), coll(cptr))
Next
End Sub

c est exactement ce que je voulais merci du fond du coeur merci

je me suis permis de le modifier pour faire la mm chose pour les chiffres

Sub denombrernombre()
Dim coll As Collection
Dim derlig As Long

derlig = Range("F65536").End(3).Row

'recherche les noms différents dans la col J
Set coll = New Collection
For cptr = 2 To derlig
On Error Resume Next
coll.Add Cells(cptr, 6).Value, CStr(Cells(cptr, 6).Value)
Next

Application.ScreenUpdating = False
'nettoie la zone de restitution
Range("P1:Q" & derlig).ClearContents

'restitue en col N les noms et en col O le nombre d'occurences
For cptr = 1 To coll.Count
Cells(cptr + 1, 16) = coll(cptr)
Cells(cptr + 1, 17) = Application.CountIf(Range("F2:F" & derlig), coll(cptr))
Next
End Sub

ça a parfaitement marche, j ai beaucoup apris grace a toi (et aux autre qui m aident aussi et aussi grace au livre pour les nuls lol ) par contre je me demande comment faire en sorte que les deux sripts soit en fait un seul et meme script ???

est ce que ça c est bon ??
Sub denombrer()
Dim coll As Collection
Dim derlig As Long

derlig = Range("J65536").End(3).Row

'recherche les noms différents dans la col J
Set coll = New Collection
For cptr = 2 To derlig
On Error Resume Next
coll.Add Cells(cptr, 10).Value, CStr(Cells(cptr, 10).Value)
Next

Application.ScreenUpdating = False
'nettoie la zone de restitution
Range("N1:O" & derlig).ClearContents

'restitue en col N les noms et en col O le nombre d'occurences
For cptr = 1 To coll.Count
Cells(cptr + 1, 14) = coll(cptr)
Cells(cptr + 1, 15) = Application.CountIf(Range("J2:J" & derlig), coll(cptr))
Next

derlig = Range("F65536").End(3).Row

'recherche les noms différents dans la col J
Set coll = New Collection
For cptr = 2 To derlig
On Error Resume Next
coll.Add Cells(cptr, 6).Value, CStr(Cells(cptr, 6).Value)
Next

Application.ScreenUpdating = False
'nettoie la zone de restitution
Range("P1:Q" & derlig).ClearContents

'restitue en col N les noms et en col O le nombre d'occurences
For cptr = 1 To coll.Count
Cells(cptr + 1, 16) = coll(cptr)
Cells(cptr + 1, 17) = Application.CountIf(Range("F2:F" & derlig), coll(cptr))
Next
End Sub

Merci, content pour toi

Oui tout a fait mais
tu peux supprimer le 2° application.screenupdating
tes 2 nombres de lignes (col F & J) ne sont ils pas les mêmes ? si oui tu peux supprimer aussi le 2° derlig

au point de vue présentation peut-^tre mettre une colonne de largeur3 entre les 2 restitutions ?

ok merci
je travaillerai la presentation apres merci mais je vais suivre ton conseil

par contre kla suis vraiment perdu sur ce meme fichier on me demande de savoir combien de fois par exemple Scannit Remote a appliquer le prix 29.78, le prix 10.27 le prix 13.69 (colone F) et ce pour chaque nom une idee ??

la j essaye si je trouve un debut de piste je veint en faire part

http://www.cijoint.fr/cjlink.php?file=cj200910/cijXFTBGuz.xls

j ai essaye avec une formule mais sa passe pas =SOMMEPRODUCT((J2:J5829="J2")*(F2:F5829="F2"))

bon je peux pas reediter le message precedent alors j en suis la mais ca donne pas grand chose et surtout si ca marche je vais devoir creer 4 macro par nom a la mains puisqu il y a 4 prix differents a chaque fois

Sub Calcultotaux()
'les Variables

Dim i As Integer, SomVal
Dim Critere1, Critere2

'Initialisation des variables
i = 2 'N° de la ligne de titre
SomVal = 0
Critere1 = "29.78" ' critere 1
Critere2 = "Scannit Remote" ' critere 2

'les conditions
If Cells(i, 6).Text = Critere1 Then
If Cells(i, 10).Text = Critere2 Then
SomVal = SomVal + Cells(i, 1).Value
End If
End If
Loop Until Cells(i + 1, 1) = ""

'Copier ton résultat dans la cellule
M.Select
Range("z7" ).Select
ActiveCell.Formula = SomVal
End Sub

bonjour,
oui faut passer par un sumproduct après avoir "déplier" les différents prix en horizontal au lieu de vertical

je te propose un truc c'taprem (ou demain car le Mistral a l'air d'être tombé chez moi d'où ballade) assez différent compte tenu du nombre de lignes et de la lenteur de sommeprod ==> tableau virtuel, mais continue de chercher quand m^me...

ok merci, oui je continu a chercher parce que j apprend plein de truc, je suis nouveau dans le vb ca fait deux semaine que j y suis essentielement pour aller plus vite dans les millers de ligne que j ai au boulot (la paresse est mere de genie non ?), et en fait ben j aime bien ca, je suis a fond meme lol

ben si j ai mieux je te ddit par contre je comprend pas le "deplier"

la paresse est mere de genie non ? Tout à fait, le + grand génie de l'humanité est ce P... de feignant qui a inventé l'essieu pour la roue!

déplier: je voulais dire au lieu de restituer les prix en colonne, les restituer en ligne
J'vas manger

je sais pas pourquoi ca ne marcahais pas j ai du creer un nouveau classeur voila ma solution mais faut que je change a la main a chaque fois le nom et que j etendent la fromule sur les autre cellule a la main.... je suis preneur de ta formule quand je vois ce qui m attent...

a table moi aussi

http://www.cijoint.fr/cjlink.php?file=cj200910/cijWMB0SyB.xls

alors ma formule finale

=SUM(($F$2:$F$5829=U2)*($J$2:$J$5829=T2))

avec explication decompose pour ceux qui passent par la
- en F2:F5828 les prix du tableau initial et en U mes 4 prix different, la formule compare donc les prix a u2 par exemple et rajooute +1 a chaque correspondance
- en j2:J5828 les nomdu tableau initial et en T le nom qui sera recherche, la formule compare donc les nom a T2 par exemple et rajooute +1 a chaque correspondance

enfin en liant les deux par le signe * on obtient une comninaison des deux c est a dire combien de fois tel personne a applique tel prix (dans mon exemple) et voila voila

bien sur on valide la formule par ctrl + MAJ + enter

par contre si tu fais une macro je suis preneur pour voir la structure et surtout pour plus de rapidite, mm si finalement une fois qu on a trouve c est pas long du tout

par macro, pratiquement instatané par un TCD

Columns("M:V").Clear
    
Range("K1") = Range("F1")
     With Range("K2")
     .FormulaR1C1 = "=RC[-5]"
    .AutoFill Destination:=Range("K2:K5829")
    End With
    ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
        "Sheet1!R1C10:R5829C11").CreatePivotTable TableDestination:= _
        "'[ccm.xls]Sheet1'!R2C13", TableName:= _
        "Tableau croisé dynamique1", DefaultVersion:=xlPivotTableVersion10
    ActiveSheet.PivotTables("Tableau croisé dynamique1").AddFields RowFields:= _
        "Employee Name", ColumnFields:="Price"
    With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("Price")
        .Orientation = xlDataField
        .Caption = "Nombre de Price"
        .Function = xlCount
    End With
    ActiveWorkbook.ShowPivotTableFieldList = True
    ActiveWorkbook.ShowPivotTableFieldList = False
    Columns("K:K").ClearContents

ccm.xls: mettre le nom du fichier réel

merci merci c est carrement instantane et parfaitement ce que je cherchais
je me permet quelque question parce que je suis la pour apprendre pas pour utiliser sans comprendre, alors si j ai bien compris pour adapter apres

parec que par exemple je comprend pas pourquoi on utilise lcolone K
Columns("M:V").Clear ' nettoit les colone M et V
Range("K1") = Range("F1")
With Range("K2")
.FormulaR1C1 = "=RC[-5]"
.AutoFill Destination:=Range("K2:K5829")
End With
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
"Sheet1!R1C10:R5829C11").CreatePivotTable TableDestination:= _ 'ici on peut modifier page mais je comprend pas R1C10:R5829C11
"'[ccm.xls]Sheet1'!R2C13", TableName:= _ ' ici on peut modifier page et classeur mais je comprend pas le R2C13
"Tableau croisé dynamique1", DefaultVersion:=xlPivotTableVersion10
ActiveSheet.PivotTables("Tableau croisé dynamique1").AddFields RowFields:= _
"Employee Name", ColumnFields:="Price" 'la on declare les liste deroulante donc on peut en rajouter
With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("Price")
.Orientation = xlDataField
.Caption = "Nombre de Price"
.Function = xlCount
End With
ActiveWorkbook.ShowPivotTableFieldList = True
ActiveWorkbook.ShowPivotTableFieldList = False
Columns("K:K").ClearContents

et apres j ai un peut de mal, je vois qu on invoque lol le tableau dynamique et je comprend qu a la fin on nettoie la colone k donc si j ai un tableau plus grad je dois par exemple changer tout les K par une lettre plus loins.

encore merci
ps : voila t es pas oblige de repondre si t as pas envie etc

ps : voila t es pas oblige de repondre si t as pas envie etc: les forums sont basés sur le partage des connaissances; j'ai beaucoup appris et continue d'apprendre par les forums et leurs FAQ, donc...

Columns("M:V").Clear ' nettoit les colone M à V

je comprend pas R1C10:R5829C11 : correspond à J1:K5829 R1C1 correpond à L1C1 (outils-options-général-L1C1)

je comprend pas le R2C13 : correspond à M2: endroit choisi pour mettre le tableau

la on declare les liste deroulante donc on peut en rajouter oui, mais je vire la colonne K pour des soucis de présentation, il faut donc relancer la macro: mon TCD n'est plus dynamique
Essaies en gardant la colonne K*** t en la masquant
columns("K:K").Hidden = True
(pas sûr que le TCD apprécie de masquer sa source, mais je n'ai pas essayé...)

Si tu veux te perfectionner avec les TCD , autres formules et VBA Excel, mets ce site dans tes marques-pages (ou favoris...)
http://boisgontierjacques.free.fr/
et aussi celui d'un de mes vieux potes-forums mais déjà plus trapu
https://silkyroad.developpez.com/]

***:pourquoi la colonne K ?: il faut que les colonnes-sources du TCD soient jointives (on peut faire autrement mais...)

thank you for les tutos et les explications et surtout l aide, a bientot surement sur le forum lool