Une macro dans Exel
jpleroisse
Messages postés
1788
Date d'inscription
mardi 7 novembre 2000
Statut
Membre
Dernière intervention
11 mars 2006
-
10 févr. 2005 à 00:54
mrdep1978 Messages postés 402 Date d'inscription jeudi 25 novembre 2004 Statut Membre Dernière intervention 7 juin 2009 - 10 févr. 2005 à 11:12
mrdep1978 Messages postés 402 Date d'inscription jeudi 25 novembre 2004 Statut Membre Dernière intervention 7 juin 2009 - 10 févr. 2005 à 11:12
A voir également:
- Dim boursorama
- Lancer une macro automatiquement tous les jours - Forum VBA Office (Excel, Word ...)
- Activer macro outlook - Forum VBA Office (Excel, Word ...)
- Macro excel copier coller cellule dans une autre feuille ✓ - Forum Visual Basic
- ¤¤¤ Lancer une macro au démarrage d'outlook ¤¤¤ - Forum Visual Basic
- Une petite aide svp pour un état d'avancement d'une macro!!! - Forum Visual Basic
1 réponse
mrdep1978
Messages postés
402
Date d'inscription
jeudi 25 novembre 2004
Statut
Membre
Dernière intervention
7 juin 2009
7
10 févr. 2005 à 11:12
10 févr. 2005 à 11:12
J'espère que ce qu'il y a ci-dessous est assez clair
Tu n'as qu'à mettre dans une cellule :
=NBCommuns(A1:E7;A7:I17)
et dans un module :Public Function NBCommuns(a_Range1 As Range, a_Range2 As Range, Optional lb_ToutesOccurrences1 As Boolean False, Optional lb_ToutesOccurrences2 As Boolean False) As Long
Dim ll_Col As Long
Dim l_Range As Range
Dim ll_cpt As Long
Dim l_Cell As Range
Dim ls_FAddress As String
Dim ls_AAddress As String
Dim ls_DejaLu As String
ll_cpt = 0
'Parcourt toutes les cellules de la zone 1
For Each l_Cell In a_Range1
'Si la cellule n'est pas vide
If l_Cell.Value <> Empty Then
'On vérifie si on a déjà traité cette valeur ou si on récupère toutes les occurrences de la 1e zone
If InStr(1, ls_DejaLu, l_Cell.Value & Chr(1)) = 0 Or lb_ToutesOccurrences1 Then
'Ajoute le contenu de la cellule à la liste des valeurs déjà traitées
ls_DejaLu = ls_DejaLu & l_Cell.Value & Chr(1)
'Cherche dans la zone 2 une cellule contenant la valeur
Set l_Range = a_Range2.Find(l_Cell.Value, , xlValues)
'Si on en a trouvé une ...
If Not l_Range Is Nothing Then
'Si on veut toutes les occurrences de la zone 2,
'on continue de parcourir la zone afin de calculer le nb de fois où la valeur est représentée
If lb_ToutesOccurrences2 Then
ls_FAddress = l_Range.Address
ls_AAddress = ""
'Le Find boucle en continu. Si on retourne sur la 1e bonne cellule de la zone2,
'c'est qu'on a parcouru l'ensemble de la zone
While ls_FAddress <> ls_AAddress
ll_cpt = ll_cpt + 1
'Cherche l'occurrence suivante
Set l_Range = a_Range2.Find(l_Cell.Value, l_Range, xlValues)
If l_Range Is Nothing Then
ls_AAddress = ls_FAddress
Else
ls_AAddress = l_Range.Address
End If
Wend
Else
'On ne comptabilise qu'une seule fois la valeur, même si elle présente plusieurs fois dans la zone 2
ll_cpt = ll_cpt + 1
End If
End If
End If
End If
Next l_Cell
NBCommuns = ll_cpt
End Function
Les parametres lb_ToutesOccurrences1 et lb_ToutesOccurrences2 servent indiquer si on veut travailler sur des valeurs distinctes ou non.
Par exemple, si dans ta 1e plage(A1:E7) tu as 2 fois "toto" et dans ta 2e plage (A7:I7) tu as 3 fois "toto"
nbcommuns(A1:E7;A7:I7) te renvoie 1 car on a trouvé au moins 1 fois toto dans les 2 zones
nbcommuns(A1:E7;A7:I7;VRAI;FAUX) te renvoie 2 car on a trouvé 2 fois toto dans la zone 1 et au moins une fois "toto" dans la zone 2
nbcommuns(A1:E7;A7:I7;FAUX;VRAI) te renvoie 3 car on a trouvé au moins 1 fois tot dans la zone 1 et 3 fois dans la zone 2
nbcommuns(A1:E7;A7:I7;VRAI;VRAI) te renvoie 6 car on a trouvé 2 fois "toto" dans la zone 1 * 3 fois "toto" dans la zone 2
Tu n'as qu'à mettre dans une cellule :
=NBCommuns(A1:E7;A7:I17)
et dans un module :Public Function NBCommuns(a_Range1 As Range, a_Range2 As Range, Optional lb_ToutesOccurrences1 As Boolean False, Optional lb_ToutesOccurrences2 As Boolean False) As Long
Dim ll_Col As Long
Dim l_Range As Range
Dim ll_cpt As Long
Dim l_Cell As Range
Dim ls_FAddress As String
Dim ls_AAddress As String
Dim ls_DejaLu As String
ll_cpt = 0
'Parcourt toutes les cellules de la zone 1
For Each l_Cell In a_Range1
'Si la cellule n'est pas vide
If l_Cell.Value <> Empty Then
'On vérifie si on a déjà traité cette valeur ou si on récupère toutes les occurrences de la 1e zone
If InStr(1, ls_DejaLu, l_Cell.Value & Chr(1)) = 0 Or lb_ToutesOccurrences1 Then
'Ajoute le contenu de la cellule à la liste des valeurs déjà traitées
ls_DejaLu = ls_DejaLu & l_Cell.Value & Chr(1)
'Cherche dans la zone 2 une cellule contenant la valeur
Set l_Range = a_Range2.Find(l_Cell.Value, , xlValues)
'Si on en a trouvé une ...
If Not l_Range Is Nothing Then
'Si on veut toutes les occurrences de la zone 2,
'on continue de parcourir la zone afin de calculer le nb de fois où la valeur est représentée
If lb_ToutesOccurrences2 Then
ls_FAddress = l_Range.Address
ls_AAddress = ""
'Le Find boucle en continu. Si on retourne sur la 1e bonne cellule de la zone2,
'c'est qu'on a parcouru l'ensemble de la zone
While ls_FAddress <> ls_AAddress
ll_cpt = ll_cpt + 1
'Cherche l'occurrence suivante
Set l_Range = a_Range2.Find(l_Cell.Value, l_Range, xlValues)
If l_Range Is Nothing Then
ls_AAddress = ls_FAddress
Else
ls_AAddress = l_Range.Address
End If
Wend
Else
'On ne comptabilise qu'une seule fois la valeur, même si elle présente plusieurs fois dans la zone 2
ll_cpt = ll_cpt + 1
End If
End If
End If
End If
Next l_Cell
NBCommuns = ll_cpt
End Function
Les parametres lb_ToutesOccurrences1 et lb_ToutesOccurrences2 servent indiquer si on veut travailler sur des valeurs distinctes ou non.
Par exemple, si dans ta 1e plage(A1:E7) tu as 2 fois "toto" et dans ta 2e plage (A7:I7) tu as 3 fois "toto"
nbcommuns(A1:E7;A7:I7) te renvoie 1 car on a trouvé au moins 1 fois toto dans les 2 zones
nbcommuns(A1:E7;A7:I7;VRAI;FAUX) te renvoie 2 car on a trouvé 2 fois toto dans la zone 1 et au moins une fois "toto" dans la zone 2
nbcommuns(A1:E7;A7:I7;FAUX;VRAI) te renvoie 3 car on a trouvé au moins 1 fois tot dans la zone 1 et 3 fois dans la zone 2
nbcommuns(A1:E7;A7:I7;VRAI;VRAI) te renvoie 6 car on a trouvé 2 fois "toto" dans la zone 1 * 3 fois "toto" dans la zone 2