XL 2010 Dénombrer et evaluer groupe après suppression de doublons

[chvalet]

Bonjour le forum

ci joint un fichier avec une feuille base avec un tableau à 5 colonnes.
Je souhaite dénombrer le nombre d'épreuves qu'un sportif a fait puis mettre une note selon le nombre trouvé
Mais si le sportif a fait 2 fois la même épreuve, alors cela compte pour 1 . En gros, je supprime le doublon avant de dénombrer

1- j'ai d'abord copier le tableau de la feuille "base" vers la feuille "0doublon" puis supprimer les doublons coïncidant aux 3 1eres colonnes du tableau
==> j'ai trouvé ce code qui fonctionne

<code>
Columns("A:F").Select
Selection.Copy
Sheets("dedoubler").Select
Sheets("dedoubler").Name = "dedoubler"
Range("A1").Select
ActiveSheet.Paste
Range("A1").Select


Range("a2:f" & Cells(Rows.Count, 1).End(3).Row).RemoveDuplicates Columns:=Array(1, 2, 3)
<code>


2- dans la feuille dénombrer
je souhaite connaitre pour chaque sportif (nom-classe) le nombre de fois qu'il apparait en feuille 0doublon


3-Evaluer
et je souhaite utiliser recherchev dans une boucle pour que tous els sportifs soient évaluer selon le tableau de la feuille parametre


Un colistier pourrait-il m aider car je n'ai pas connaissance des boucles vba


merci d avance
chvalet

 

[Staple1600]

Bonjour à tous

Juste une suggestion en passant
Tu peux alléger ta macro en ne passant pas par les Select Activate et cie ;

Sub a()
Sheets("base").Range("A2:D10000").Copy Sheets("0doublon").[A1]
Sheets("0doublon").Range("A1:D" & Cells(Rows.Count, 1).End(3).Row).RemoveDuplicates Array(1, 2, 3), 1
End Sub

PS: Dans ton exemple, ton tableau est en colonne A:D, d'où la modif dans la macro.

Dans ton fichier, il n'y a pas de feuille Parametres

 

[chvalet]

Bonjour
merci
la feuille parametre était masquée

chvalet

 

[chvalet]

Salut
j'ai épuré ma macro

mais je bloque sur le reste (dénombrer et valuer)

merci
Chvalet

 

[Staple1600]

Re

On n'était pas censé le savoir qu'elle était masquée

Sinon pour le dénombrement pourquoi ne pas utiliser un TCD?

NB: Pour conserver tes macros, il faut enregistrer tes fichiers en *.xlsm mais surtout pas en *.xlsx.
Sinon dans ce cas, le classeur ne contient plus aucune macros.

 

[chvalet]

Bonjour

merci
pardon, oui c'est vrai j'aurais pu la démasquer mais cette feuille doit rester cachée pour éviter que les collègues ne la modifient

Je préfère les macros au tcd car en un clic tout se fait avec les tcd il faut réactualiser.

Je voudrais connaitre la solution pour faire une boucle et créer une formule telle que
dans la feuille 0doublon
pour toutes lignes non vides ajouter en colonne D le résultat de la formule
concat (a2&b2)

puis

dans la feuille denombrer
pour toutes les lignes non vides créer une boucles avec 3 formules dans 3 colonnes c/d/e
ex pour ligne 2
concatener(a2;b2) en C2
nb.si(o-doublons a2:d10000; c2) en D2
recherchev(c2;note;2) en E2


merci
Chvalet

 

[Staple1600]

Re

Pas besoin de boucle

Sub b()
Sheets("base").Range("A2:C10000").Copy Sheets("0doublon").[A2]
Wtih Sheets("0doublon")
.Range("A2:C" & Cells(Rows.Count, 1).End(3).Row).RemoveDuplicates Array(1, 2, 3), 1
.Range("D2") = "concat"
.Range("D3:D" & Cells(Rows.Count, 1).End(3).Row) = "=RC[-3]&RC[-2]"
End With
End Sub

 

[chvalet]

Bonjour

voici le code et le fichier

Sub a()

'phase 1 feuille 0-doublon
'nettoyer feuille
Sheets("0doublon").Select
Range("A2100000").Select
Selection.ClearContents

'copier base et supprimer doublons dans feuille 0-doublons
'copier base
Sheets("base").Range("A2:C100000").Copy Sheets("0doublon").[A1]

With Sheets("0doublon")
'supprimer doublons
.Range("A1:C" & Cells(Rows.Count, 1).End(3).Row).RemoveDuplicates Array(1, 2, 3), 1
'concatener
.Range("D1") = "concat"
.Range("D2" & Cells(Rows.Count, 1).End(3).Row) = "=RC[-3]&RC[-2]"
End With

' phase 2 feuille denombrer
Sheets("0Doublon").Range("A2:C100000").Copy Sheets("0doublon").[A1]

'nettoyer feuille denombrer
Sheets("denombrer").Select
Range("A2100000").Select
Selection.ClearContents

'copier données 0doublons vers feuille denombrer
Sheets("0doublon").Range("A1:B100000").Copy Sheets("DENOMBRER").[A1]

With Sheets("denombrer")
'Supprimer doublons
.Range("A1:B" & Cells(Rows.Count, 1).End(3).Row).RemoveDuplicates Array(1, 2), 1

'concatener
.Range("C1") = "concat"
.Range("C2:C" & Cells(Rows.Count, 1).End(3).Row) = "=RC[-2]&RC[-1]"

'denombrer
.Range("D1") = "Dénombrer"
.Range("D2" & Cells(Rows.Count, 1).End(3).Row) = "=COUNTIF('0doublon'!C,denombrer!RC[-1])"

'Evaluer
.Range("E1") = "Note"
.Range("E2:E" & Cells(Rows.Count, 1).End(3).Row) = "=VLOOKUP(RC[-1],note,2)"
End With


'supprimer les colonnes concat
'masquer feuille 0-doublon

End Sub


==> cependant si je veux supprimer les colonnes "concat" à la fin, ça ne fonctionne plus car les formules sont actives dans les cellules
sauf si je passe par un copier/ collage spécial
mais je suppose qu'il ya mieux .

Cdl
Chvalet

 

[chvalet]

Salut

une petite erreur lors du copier/coller

Sub a()

'phase 1 feuille 0-doublon
'nettoyer feuille
Sheets("0doublon").Select
Range("A2100000").Select
Selection.ClearContents

'copier base et supprimer doublons dans feuille 0-doublons
'copier base
Sheets("base").Range("A2:C100000").Copy Sheets("0doublon").[A1]

With Sheets("0doublon")
'supprimer doublons
.Range("A2:C" & Cells(Rows.Count, 1).End(3).Row).RemoveDuplicates Array(1, 2, 3), 1
'concatener
.Range("D1") = "concat"
.Range("D2" & Cells(Rows.Count, 1).End(3).Row) = "=RC[-3]&RC[-2]"
End With

' phase 2 feuille denombrer

'nettoyer feuille denombrer
Sheets("denombrer").Select
Range("A2:E100000").Select
Selection.ClearContents

'copier données 0doublons vers feuille denombrer
Sheets("0doublon").Range("A1:B100000").Copy Sheets("DENOMBRER").[A1]

With Sheets("denombrer")
'Supprimer doublons
.Range("A1:B" & Cells(Rows.Count, 1).End(3).Row).RemoveDuplicates Array(1, 2), 1

'concatener
.Range("C1") = "concat"
.Range("C2:C" & Cells(Rows.Count, 1).End(3).Row) = "=RC[-2]&RC[-1]"

'denombrer
.Range("D1") = "Dénombrer"
.Range("D2" & Cells(Rows.Count, 1).End(3).Row) = "=COUNTIF('0doublon'!C,denombrer!RC[-1])"

'Evaluer
.Range("E1") = "Note"
.Range("E2:E" & Cells(Rows.Count, 1).End(3).Row) = "=VLOOKUP(RC[-1],note,2)"
End With

'masquer feuille 0-doublon
'supprimer les colonnes concat

End Sub

mais toujours le probleme de la suppresion de concat qui entraine une erreur de note

Chvalet