Figer la valeur de cellules après passage d'une macro
Bonjour,
A/ la macro appréciationpfmpe3132 ci dessous lance une macro appelée PFMP1 qui fait un filtre dans un tableau qui se trouve sur une autre feuille. fin de la macro pfmp1
Ensuite la macro appréciationpfmpe3132 sélectionne la feuil55 et fait compter les lettres a, b, c, d du tableau dans 4 cellules différentes
Jusque là tout va bien
B/La macro appréciationpfmpe3132 lance dans la foulée une macro appelée PFMP2 qui fait un autre filtre dans ce même tableau
Puis elle sélectionne la feuil55 et compte là aussi les lettres a, b, c et d et écrit ces comptes dans d'autres cellules.
Le problème est que la partie A de ma macro compte les a,b,c et d de la partie B de ma macro.
Qqun aurait il une solution svp ?
Sub appréciationpfmpe3132()
'
' appréciationpfmpe3132 Macro
'
Run "pfmp1"
Feuil55.Select
Range("A83").Select
ActiveCell.FormulaR1C1 = "=COUNTIF(Saisie!C[5]:C[6],""a"")"
Range("A84").Select
ActiveCell.FormulaR1C1 = "=COUNTIF(Saisie!C[5]:C[6],""b"")"
Range("A85").Select
ActiveCell.FormulaR1C1 = "=COUNTIF(Saisie!C[5]:C[6],""c"")"
Range("A86").Select
ActiveCell.FormulaR1C1 = "=COUNTIF(Saisie!C[5]:C[6],""d"")"
Run "pfmp2"
Feuil55.Select
Range("A140").Select
ActiveCell.FormulaR1C1 = "=COUNTIF(Saisie!C[5]:C[6],""a"")"
Range("A141").Select
ActiveCell.FormulaR1C1 = "=COUNTIF(Saisie!C[5]:C[6],""b"")"
Range("A142").Select
ActiveCell.FormulaR1C1 = "=COUNTIF(Saisie!C[5]:C[6],""c"")"
Range("A143").Select
ActiveCell.FormulaR1C1 = "=COUNTIF(Saisie!C[5]:C[6],""d"")"
Range("a1").Select
End Suble problème ne viendrait pas du fait que je fais écrire la formule NB.si à votre avis ?
il faudrait qu'il compte mais sans écrire la formule dans la cellule non ?
Mais comment écrire de compter ?
Bonjour,
Je crois que NB.SI compte toutes les valeurs y compris les cachées.
Pour compter les valeurs des lignes visibles après filtre, je propose le code suivant :
(Au préalable, dans le tableau, nommer la plage sur laquelle s'effectuera les calculs -sans filtre)
Sub Compter_Val_Filtrées()
Dim Nb_A, Nb_B, Nb_C, Nb_D As Integer
Range("A1:A4").ClearContents
For Each Cell In Range("MaPlage").SpecialCells(xlCellTypeVisible)
If Cell = "a" Then
Nb_A = Nb_A + 1
Else
If Cell = "b" Then
Nb_B = Nb_B + 1
Else
If Cell = "c" Then
Nb_C = Nb_C + 1
Else
If Cell = "d" Then
Nb_D = Nb_D + 1
End If
End If
End If
End If
Next
Range("A1") = Nb_A
Range("A2") = Nb_B
Range("A3") = Nb_C
Range("A4") = Nb_DMerci ça a l'air de marcher super. Et effectivement, pour le NB.si je pense comme toi car je trouvais des résultats surprenants parfois.
Le code dans mon cas est le suivant. J'ai adapté un peu... je ne sais pas si c'est bien ou pas.... j'ai fait de mon mieux. Merci en tout cas.... Vous rendez des services qui soulagent vraiment.
Sub appréciationpfmpe3132()
'
' appréciationpfmpe31 Macro
'
Feuil55.Range("a83:a86").ClearContents
Feuil55.Range("a140:a143").ClearContents
Feuil55.Range("a177:a180").ClearContents
Run "pfmp1"
Dim Nb_A, Nb_B, Nb_C, Nb_D As Integer
For Each Cell In Range("G10:G2000").SpecialCells(xlCellTypeVisible)
If Cell = "a" Then
Nb_A = Nb_A + 1
Else
If Cell = "b" Then
Nb_B = Nb_B + 1
Else
If Cell = "c" Then
Nb_C = Nb_C + 1
Else
If Cell = "d" Then
Nb_D = Nb_D + 1
End If
End If
End If
End If
Next
Feuil55.Select
Range("A83") = Nb_A
Range("A84") = Nb_B
Range("A85") = Nb_C
Range("A86") = Nb_D
Run "pfmp2"
Dim Nb_E, Nb_F, Nb_G, Nb_H As Integer
For Each Cell In Range("G10:G2000").SpecialCells(xlCellTypeVisible)
If Cell = "a" Then
Nb_E = Nb_E + 1
Else
If Cell = "b" Then
Nb_F = Nb_F + 1
Else
If Cell = "c" Then
Nb_G = Nb_G + 1
Else
If Cell = "d" Then
Nb_H = Nb_H + 1
End If
End If
End If
End If
Next
Feuil55.Select
Range("A140") = Nb_E
Range("A141") = Nb_F
Range("A142") = Nb_G
Range("A143") = Nb_H
Run "pfmp3"
Dim Nb_I, Nb_J, Nb_K, Nb_L As Integer
For Each Cell In Range("G10:G2000").SpecialCells(xlCellTypeVisible)
If Cell = "a" Then
Nb_I = Nb_I + 1
Else
If Cell = "b" Then
Nb_J = Nb_J + 1
Else
If Cell = "c" Then
Nb_K = Nb_K + 1
Else
If Cell = "d" Then
Nb_L = Nb_L + 1
End If
End If
End If
End If
Next
Feuil55.Select
Range("A177") = Nb_I
Range("A178") = Nb_J
Range("A179") = Nb_K
Range("A180") = Nb_L
End SubJe pense qu'on peut encore simplifier mais il est très bien ton code.
Une petite astuce pour qu'il s'excute un peu plus vite :
placer en début de macro
Application.Screen.Updating = Falseet en fin de macro
Application.Screen.Updating = TrueCela neutralise les rafraichissement d'écran pendant l'exécution de la macro
Tu es sympa mais c'est ton code. Moi j'ai juste été capable d'adapter le tien.
Merci pour ton astuce.
D'ailleurs en parlant d'astuce, j'arrive après des centaines d'heures à la fin d'un projet. Enfin j'espère que j'y arrive......
Je voudrais nettoyer mes feuilles Excel maintenant pour que ça aille plus vite et éviter des plantages ou je ne sais quoi.
J'ai pleins de modules vides. je ne sais pas pourquoi je peux les effacer ou cela pose un souci?
ça se fait de mettre des macros dans un post juste pour qu'on les optimise... enfin les arrange un peu si y a des gros pbs.... même si ça prend qques secondes de plus ce n'est pas un souci non plus. ?
C'est effectivement plus propre de supprimer les modules vides, ils ne servent strictement à rien.
Pour l'optimisation du code, tu peux les soumettre. On apprend beaucoup en regardant comment les autres simplifient.
Bonne journée
Bonjour,
le code ci dessous proposé par ouisansdoute fonctionne bien et je l'en remercie encore. LOrsqu'il y n'y a pas de résultat pour le filtre, il me donne bien les infos qu'il faut et les inscrit bien là où il faut c'est ok.
Mais j'ai l'impression que cela bloque mon tableau lorsqu'il y a zéro résultat pour le filtre. En effet, lorsque je lance la macro parfois il y a zéro résultat. Et si c'est ce cas là qui se présente, il inscrit bien les zéros là où il faut MAIS quand je retourne dans mon tableau pour faire de la saisie par exemple, je ne peux pas enlever le filtre. J'ai l'impression que le fait qu'il y ait zéro résultat a bloqué mon tableau.
Voici le code. Merci de votre aide
Sub appréciationpfmpe3132()
'
' appréciationpfmpe31 Macro
'
Feuil55.Range("a83:a86").ClearContents
Feuil55.Range("a140:a143").ClearContents
Feuil55.Range("a177:a180").ClearContents
Run "pfmp1"
Dim Nb_A, Nb_B, Nb_C, Nb_D As Integer
For Each Cell In Range("H10:H2000").SpecialCells(xlCellTypeVisible)
If Cell = "a" Then
Nb_A = Nb_A + 1
Else
If Cell = "b" Then
Nb_B = Nb_B + 1
Else
If Cell = "c" Then
Nb_C = Nb_C + 1
Else
If Cell = "d" Then
Nb_D = Nb_D + 1
End If
End If
End If
End If
Next
Feuil55.Select
Range("A83") = Nb_A
Range("A84") = Nb_B
Range("A85") = Nb_C
Range("A86") = Nb_D
Run "pfmp2"
Dim Nb_E, Nb_F, Nb_G, Nb_H As Integer
For Each Cell In Range("H10:H2000").SpecialCells(xlCellTypeVisible)
If Cell = "a" Then
Nb_E = Nb_E + 1
Else
If Cell = "b" Then
Nb_F = Nb_F + 1
Else
If Cell = "c" Then
Nb_G = Nb_G + 1
Else
If Cell = "d" Then
Nb_H = Nb_H + 1
End If
End If
End If
End If
Next
Feuil55.Select
Range("A140") = Nb_E
Range("A141") = Nb_F
Range("A142") = Nb_G
Range("A143") = Nb_H
Run "pfmp3"
Dim Nb_I, Nb_J, Nb_K, Nb_L As Integer
For Each Cell In Range("H10:H2000").SpecialCells(xlCellTypeVisible)
If Cell = "a" Then
Nb_I = Nb_I + 1
Else
If Cell = "b" Then
Nb_J = Nb_J + 1
Else
If Cell = "c" Then
Nb_K = Nb_K + 1
Else
If Cell = "d" Then
Nb_L = Nb_L + 1
End If
End If
End If
End If
Next
Feuil55.Select
Range("A177") = Nb_I
Range("A178") = Nb_J
Range("A179") = Nb_K
Range("A180") = Nb_L
End Sub