colorier des cellules et les compter Résolu/Fermé

Question

Bonjour, tout le monde ayant deja recu une aide de l un d entre vous qui m a sauve je reviens vers vous pour une autre question (je travaille sous office 2003) (dsl pour les accents suis en angleterre) je voudrais faire une macro qui me demande quel mot chercher et une fois que je l indique que la macro colore le case ou le mot (preference pour la case) et me dise combien de fois il a trouve pour le moment j'utilise la formule =COUNTIF($j$2:$j$5829,"airbus") et ensuite je copie le nom dans cette macro que j ai plus ou moins creer adapte d ailleur lol Sub formatConditionnelle() Application.ScreenUpdating = False For Each c In [j2:j2858] 'plage a testée c.Select Dim l As Long l = ActiveCell.[Row] If ActiveCell.Value = "Scannit Remote" And ActiveCell.Offset(0, 9) <> "" Then Rows("" & l & ":" & l & "").Select Selection.Font.ColorIndex = 45 Else If ActiveCell.Value = "Scannit Remote" And ActiveCell.Offset(0, 9) = "" Then Rows("" & l & ":" & l & "").Select Selection.Font.ColorIndex = 5 Else Rows("" & l & ":" & l & "").Select Selection.Font.ColorIndex = 1 End If End If Next Application.ScreenUpdating = True Range("f1").Select End Sub Sub fo() Application.ScreenUpdating = False For Each c In [j2:j2858] 'plage a testée c.Select Dim l As Long l = ActiveCell.[Row] If ActiveCell.Value = "PremVet Remote" And ActiveCell.Offset(0, 9) <> "" Then Rows("" & l & ":" & l & "").Select Selection.Font.ColorIndex = 45 Else If ActiveCell.Value = "PremVet Remote" And ActiveCell.Offset(0, 9) = "" Then Rows("" & l & ":" & l & "").Select Selection.Font.ColorIndex = 5 Else Rows("" & l & ":" & l & "").Select Selection.Font.ColorIndex = 1 End If End If Next Application.ScreenUpdating = True Range("f1").Select End Sub du coup a chaque fois je suis oblige de copier coller le corp de la macro a sa suite et de changer le non a la main.

manautop · Answer

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

michel_m · Answer

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

manautop · Answer

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

michel_m · Answer

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 ?

manautop · Answer

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"))

manautop · Answer

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

michel_m · Answer

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...

manautop · Answer

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"

michel_m · Answer

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

manautop · Answer

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

manautop · Answer

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

michel_m · Answer

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

manautop · Answer

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

michel_m · Answer

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...)

manautop · Answer

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

Colorier des cellules et les compter

15 réponses

Discussions similaires