1 pièce(s) jointe(s)
Executer une macro chaque fois qu'on a une valeur differente dans une colonne donnée
Bonjour à toutes et tous ,
Voilà j'ai un gros tableau de données que j'ai simplifié pour obtenir votre aide;
Dans ce tableau j'ai deux colonnes : Nature de prestation et assurés voir la photo
j'ai une macro un peu bancale mais fonctionnelle qui me permet de filtrer une nature de prestation exemple ABA et de compter le nombre d'assurés sans doublon qui bénéficient de cette prestation.
Dans mon exemple si on filtre ABA on obtient 4 assurés uniques.
Ma question comment faire pour que ma macro fasse ce calcul automatiquement pour chaque nature de prestation donc pour ABA, ABG, ATP ect ?
Cela sans que j'ai à remplir mon inputbox.
Voici ma macro:
Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
| Sub AssUniq()
Application.ScreenUpdating = False
'On va compter le nombre d'assurés uniques ayant utilisé une nature de prestation à choisir
Dim MonFiltre As String
'Dim MonOnglet As String
MonFiltre = InputBox("Choississez la nature de prestation")
'MonOnglet = InputBox("Entrez le nom de l'onglet")
Sheets("Donnees").Activate
DernLigne = Range("A" & Rows.Count).End(xlUp).Row
Rows("1:1").Select
Selection.AutoFilter
'ActiveSheet.Range("$A$1:$Z" & DernLigne).AutoFilter Field:=2, Criteria1:="ABA"
ActiveSheet.Range("$A$1:$Z" & DernLigne).AutoFilter Field:=2, Criteria1:=MonFiltre
Range("A1").Select
Range("A1:Z" & DernLigne).Select
Selection.Copy
' Sheets.Add After:=Sheets(Sheets.Count)
Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = MonFiltre & "_" & "AssUniq"
ActiveSheet.Paste
ActiveSheet.Paste
Application.CutCopyMode = False
Columns("C:C").Select
ActiveSheet.Range("$C$1:$C" & DernLigne).RemoveDuplicates Columns:=1, Header:= _
xlYes
Range("A1").Select
ActiveSheet.Cells(Rows.Count, "A").End(xlUp)(2).Offset(, 2) = Application.WorksheetFunction.CountA(Columns(3))
Sheets("Donnees").Select
ActiveSheet.Range("$A$1:$Z" & DernLigne).AutoFilter Field:=2
Application.ScreenUpdating = True
End Sub |
Pièce jointe 363045
et un exemple de mon tableau source
Merci de votre aide.
