Procédure trop grande en VBA [Résolu]

Réponse 2 / 6

Chtitmiss

Voici le début du code :
Sub Resultats()

'Déclaration des feuilles de travail
Dim Donnees As Worksheet
Dim Resultats As Worksheet

Set Donnees = ActiveWorkbook.Worksheets("Donnees")
Set Resultats = ActiveWorkbook.Worksheets("Resultats")

'Déclaration des variables de la feuille "Donnees"
Dim mois As Range
Dim Sexe As Range
Dim sitfam As Range
Dim nbenf As Range
Dim age As Range
Dim act1 As Range
Dim act2 As Range
Dim ress1 As Range
Dim ress2 As Range
Dim logement As Range
Dim dec1 As Range
Dim dec2 As Range

'Compte le nombre de lignes non vides
Dim i As Integer
Dim num As Range
i = 1
Do
Set num = Donnees.Range("A" & i)
i = i + 1
Loop While num.Value <> ""
i = i - 2

'Utilisation du mois
Dim j As Integer
Dim m As Integer

'Sexe
Dim fem As Range
Dim hom As Range

'Situation familiale
Dim celib As Range
Dim coupleseul As Range
Dim persavecenf As Range
Dim coupleenf As Range

'Age
Dim moins25 As Range
Dim entre2534 As Range
Dim entre3544 As Range
Dim entre4554 As Range
Dim entre5564 As Range
Dim plus65 As Range

'Activité
Dim salarie As Range
Dim ddemploi As Range
Dim amm As Range
Dim inval As Range
Dim retraite As Range
Dim autre As Range

'Ressources
Dim salaire As Range
Dim assedic As Range
Dim RSA As Range
Dim PensionAlim As Range
Dim IJ As Range
Dim CAF As Range
Dim PIAAH As Range
Dim MVA As Range
Dim retr As Range
Dim sans As Range
Dim attente As Range

'Logements
Dim logpublic As Range
Dim logprive As Range
Dim heberge As Range
Dim logccas As Range
Dim autrelog As Range

'Décisions
Dim st As Range 'Secours Tiers
Dim se As Range 'Secours Espèces
Dim scb As Range 'Secours Compte Bancaire
Dim ts As Range 'Tickets Service
Dim edf As Range
Dim gaz As Range
Dim avq As Range
Dim mutuelle As Range
Dim auberge As Range

'Programme permettant de compléter le tableau
For j = 1 To i

Set mois = Donnees.Range("B" & j)
Set Sexe = Donnees.Range("C" & j)
Set sitfam = Donnees.Range("E" & j)
Set nbenf = Donnees.Range("F" & j)
Set age = Donnees.Range("D" & j)
Set act1 = Donnees.Range("G" & j)
Set act2 = Donnees.Range("H" & j)
Set ress1 = Donnees.Range("I" & j)
Set ress2 = Donnees.Range("J" & j)
Set logement = Donnees.Range("K" & j)
Set dec1 = Donnees.Range("L" & j)
Set dec2 = Donnees.Range("M" & j)

'Janvier
If mois.Value = "Janvier" Then
m = 3

'Sexe
Set fem = Resultats.Range("C" & m)
Set hom = Resultats.Range("B" & m)
If Sexe.Value = "F" Then
fem.Value = fem.Value + 1
Else
If Sexe.Value = "M" Then
hom.Value = hom.Value + 1
End If
End If

'Situation familiale
Set celib = Resultats.Range("E" & m)
Set coupleseul = Resultats.Range("F" & m)
Set persavecenf = Resultats.Range("G" & m)
Set coupleenf = Resultats.Range("H" & m)
If nbenf.Value = 0 Then
If sitfam.Value = "Seul" Then
celib.Value = celib.Value + 1
Else
If sitfam.Value = "Couple" Then
coupleseul.Value = coupleseul.Value + 1
End If
End If
Else
If nbenf.Value > 0 Then
If sitfam.Value = "Seul" Then
persavecenf.Value = persavecenf.Value + 1
Else
If sitfam.Value = "Couple" Then
coupleenf.Value = coupleenf.Value + 1
End If
End If
End If
End If

'Age
Set moins25 = Resultats.Range("I" & m)
Set entre2534 = Resultats.Range("J" & m)
Set entre3544 = Resultats.Range("K" & m)
Set entre4554 = Resultats.Range("L" & m)
Set entre5564 = Resultats.Range("M" & m)
Set plus65 = Resultats.Range("N" & m)
If age.Value = "<25" Then
moins25.Value = moins25.Value + 1
Else
If age.Value = "25/34" Then
entre2534.Value = entre2534.Value + 1
Else
If age.Value = "35/44" Then
entre3544.Value = entre3544.Value + 1
Else
If age.Value = "45/54" Then
entre4554.Value = entre4554.Value + 1
Else
If age.Value = "55/64" Then
entre5564.Value = entre5564.Value + 1
Else
If age.Value = ">65" Then
plus65.Value = plus65.Value + 1
End If
End If
End If
End If
End If
End If
'
'Activité
Set salarie = Resultats.Range("O" & m)
Set ddemploi = Resultats.Range("P" & m)
Set amm = Resultats.Range("Q" & m)
Set inval = Resultats.Range("R" & m)
Set retraite = Resultats.Range("S" & m)
Set autre = Resultats.Range("T" & m)
If act1.Value = "Salarié" Then
salarie.Value = salarie.Value + 1
Else
If act1.Value = "Demandeur d'emploi" Then
ddemploi.Value = ddemploi.Value + 1
Else
If act1.Value = "Arrêt maladie" Then
amm.Value = amm.Value + 1
Else
If act1.Value = "Invalidité" Then
inval.Value = inval.Value + 1
Else
If act1.Value = "Retraité" Then
retraite.Value = retraite.Value + 1
Else
autre.Value = autre.Value + 1
End If
End If
End If
End If
End If
If act2.Value <> "" Then
If act2.Value = "Salarié" Then
salarie.Value = salarie.Value + 1
Else
If act2.Value = "Demandeur d'emploi" Then
ddemploi.Value = ddemploi.Value + 1
Else
If act2.Value = "Arrêt maladie" Then
amm.Value = amm.Value + 1
Else
If act2.Value = "Invalidité" Then
inval.Value = inval.Value + 1
Else
If act2.Value = "Retraité" Then
retraite.Value = retraite.Value + 1
Else
autre.Value = autre.Value + 1
End If
End If
End If
End If
End If
End If

'Ressources
Set salaire = Resultats.Range("U" & m)
Set assedic = Resultats.Range("V" & m)
Set RSA = Resultats.Range("W" & m)
Set PensionAlim = Resultats.Range("X" & m)
Set IJ = Resultats.Range("Y" & m)
Set CAF = Resultats.Range("Z" & m)
Set PIAAH = Resultats.Range("AA" & m)
Set MVA = Resultats.Range("AB" & m)
Set retr = Resultats.Range("AC" & m)
Set sans = Resultats.Range("AD" & m)
Set attente = Resultats.Range("AE" & m)
If ress1.Value = "Salaire" Then
salaire.Value = salaire.Value + 1
Else
If ress1.Value = "ASSEDIC" Then
assedic.Value = assedic.Value + 1
Else
If ress1.Value = "RSA" Then
RSA.Value = RSA.Value + 1
Else
If ress1.Value = "Pension alimentaire" Then
PensionAlim.Value = PensionAlim.Value + 1
Else
If ress1.Value = "Indemnités Journalières" Then
IJ.Value = IJ.Value + 1
Else
If ress1.Value = "CAF" Then
CAF.Value = CAF.Value + 1
Else
If ress1.Value = "Pension d'invalidité" Or ress1.Value = "AAH" Then
PIAAH.Value = PIAAH.Value + 1
Else
If ress1.Value = "MVA" Then
MVA.Value = MVA.Value + 1
Else
If ress1.Value = "Retraite" Then
retr.Value = retr.Value + 1
Else
If ress1.Value = "Sans" Then
sans.Value = sans.Value + 1
Else
If ress1.Value = "En attente" Then
attente.Value = attente.Value + 1
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
If ress2.Value = "Salaire" Then
salaire.Value = salaire.Value + 1
Else
If ress2.Value = "ASSEDIC" Then
assedic.Value = assedic.Value + 1
Else
If ress2.Value = "RSA" Then
RSA.Value = RSA.Value + 1
Else
If ress2.Value = "Pension alimentaire" Then
PensionAlim.Value = PensionAlim.Value + 1
Else
If ress2.Value = "Indemnités Journalières" Then
IJ.Value = IJ.Value + 1
Else
If ress2.Value = "CAF" Then
CAF.Value = CAF.Value + 1
Else
If ress2.Value = "Pension d'invalidité" Or ress2.Value = "AAH" Then
PIAAH.Value = PIAAH.Value + 1
Else
If ress2.Value = "MVA" Then
MVA.Value = MVA.Value + 1
Else
If ress2.Value = "Retraite" Then
retr.Value = retr.Value + 1
Else
If ress2.Value = "Sans" Then
sans.Value = sans.Value + 1
Else
If ress2.Value = "En attente" Then
attente.Value = attente.Value + 1
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If

'Logement
Set logpublic = Resultats.Range("AF" & m)
Set logprive = Resultats.Range("AG" & m)
Set heberge = Resultats.Range("AH" & m)
Set logccas = Resultats.Range("AI" & m)
Set autrelog = Resultats.Range("AJ" & m)
If logement.Value = "Parc Privé" Then
logprive.Value = logprive.Value + 1
Else
If logement.Value = "Office Public" Then
logpublic.Value = logpublic.Value + 1
Else
If logement.Value = "Hébergé" Then
heberge.Value = heberge.Value + 1
Else
If logement.Value = "Logement CCAS" Then
logccas.Value = logccas.Value + 1
Else
autrelog.Value = autrelog.Value + 1
End If
End If
End If
End If

'Décisions
Set st = Resultats.Range("AK" & m)
Set se = Resultats.Range("AL" & m)
Set scb = Resultats.Range("AM" & m)
Set ts = Resultats.Range("AN" & m)
Set edf = Resultats.Range("AO" & m)
Set gaz = Resultats.Range("AP" & m)
Set avq = Resultats.Range("AQ" & m)
Set mutuelle = Resultats.Range("AR" & m)
Set auberge = Resultats.Range("AS" & m)
If dec1.Value = "Secours tiers" Then
st.Value = st.Value + 1
Else
If dec1.Value = "Secours espèces" Then
se.Value = se.Value + 1
Else
If dec1.Value = "Secours compte bancaire" Then
scb.Value = scb.Value + 1
Else
If dec1.Value = "Tickets service" Then
ts.Value = ts.Value + 1
Else
If dec1.Value = "EDF" Then
edf.Value = edf.Value + 1
Else
If dec1.Value = "Gaz" Then
gaz.Value = gaz.Value + 1
Else
If dec1.Value = "AVQ" Then
avq.Value = avq.Value + 1
Else
If dec1.Value = "Mutuelle" Then
mutuelle.Value = mutuelle.Value + 1
Else
If dec1.Value = "Repas Auberge" Then
auberge.Value = auberge.Value + 1
End If
End If
End If
End If
End If
End If
End If
End If
End If
If dec2.Value <> "" Then
If dec2.Value = "Secours tiers" Then
st.Value = st.Value + 1
Else
If dec2.Value = "Secours espèces" Then
se.Value = se.Value + 1
Else
If dec2.Value = "Secours compte bancaire" Then
scb.Value = scb.Value + 1
Else
If dec2.Value = "Tickets service" Then
ts.Value = ts.Value + 1
Else
If dec2.Value = "EDF" Then
edf.Value = edf.Value + 1
Else
If dec2.Value = "Gaz" Then
gaz.Value = gaz.Value + 1
Else
If dec2.Value = "AVQ" Then
avq.Value = avq.Value + 1
Else
If dec2.Value = "Mutuelle" Then
mutuelle.Value = mutuelle.Value + 1
Else
If dec2.Value = "Repas Auberge" Then
auberge.Value = auberge.Value + 1
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If

Else

'Février
If mois.Value = "Février" Then
m = 4

'Sexe
Set fem = Resultats.Range("C" & m)
Set hom = Resultats.Range("B" & m)
If Sexe.Value = "F" Then
fem.Value = fem.Value + 1
Else
If Sexe.Value = "M" Then
hom.Value = hom.Value + 1
End If
End If

'Situation familiale
Set celib = Resultats.Range("E" & m)
Set coupleseul = Resultats.Range("F" & m)
Set persavecenf = Resultats.Range("G" & m)
Set coupleenf = Resultats.Range("H" & m)
If nbenf.Value = 0 Then
If sitfam.Value = "Seul" Then
celib.Value = celib.Value + 1
Else
If sitfam.Value = "Couple" Then
coupleseul.Value = coupleseul.Value + 1
End If
End If
Else
If nbenf.Value > 0 Then
If sitfam.Value = "Seul" Then
persavecenf.Value = persavecenf.Value + 1
Else
If sitfam.Value = "Couple" Then
coupleenf.Value = coupleenf.Value + 1
End If
End If
End If
End If

'Age
Set moins25 = Resultats.Range("I" & m)
Set entre2534 = Resultats.Range("J" & m)
Set entre3544 = Resultats.Range("K" & m)
Set entre4554 = Resultats.Range("L" & m)
Set entre5564 = Resultats.Range("M" & m)
Set plus65 = Resultats.Range("N" & m)
If age.Value = "<25" Then
moins25.Value = moins25.Value + 1
Else
If age.Value = "25/34" Then
entre2534.Value = entre2534.Value + 1
Else
If age.Value = "35/44" Then
entre3544.Value = entre3544.Value + 1
Else
If age.Value = "45/54" Then
entre4554.Value = entre4554.Value + 1
Else
If age.Value = "55/64" Then
entre5564.Value = entre5564.Value + 1
Else
If age.Value = ">65" Then
plus65.Value = plus65.Value + 1
End If
End If
End If
End If
End If
End If

'Activité
Set salarie = Resultats.Range("O" & m)
Set ddemploi = Resultats.Range("P" & m)
Set amm = Resultats.Range("Q" & m)
Set inval = Resultats.Range("R" & m)
Set retraite = Resultats.Range("S" & m)
Set autre = Resultats.Range("T" & m)
If act1.Value = "Salarié" Then
salarie.Value = salarie.Value + 1
Else
If act1.Value = "Demandeur d'emploi" Then
ddemploi.Value = ddemploi.Value + 1
Else
If act1.Value = "Arrêt maladie" Then
amm.Value = amm.Value + 1
Else
If act1.Value = "Invalidité" Then
inval.Value = inval.Value + 1
Else
If act1.Value = "Retraité" Then
retraite.Value = retraite.Value + 1
Else
autre.Value = autre.Value + 1
End If
End If
End If
End If
End If
If act2.Value <> "" Then
If act2.Value = "Salarié" Then
salarie.Value = salarie.Value + 1
Else
If act2.Value = "Demandeur d'emploi" Then
ddemploi.Value = ddemploi.Value + 1
Else
If act2.Value = "Arrêt maladie" Then
amm.Value = amm.Value + 1
Else
If act2.Value = "Invalidité" Then
inval.Value = inval.Value + 1
Else
If act2.Value = "Retraité" Then
retraite.Value = retraite.Value + 1
Else
autre.Value = autre.Value + 1
End If
End If
End If
End If
End If
End If

'Ressources
Set salaire = Resultats.Range("U" & m)
Set assedic = Resultats.Range("V" & m)
Set RSA = Resultats.Range("W" & m)
Set PensionAlim = Resultats.Range("X" & m)
Set IJ = Resultats.Range("Y" & m)
Set CAF = Resultats.Range("Z" & m)
Set PIAAH = Resultats.Range("AA" & m)
Set MVA = Resultats.Range("AB" & m)
Set retr = Resultats.Range("AC" & m)
Set sans = Resultats.Range("AD" & m)
Set attente = Resultats.Range("AE" & m)
If ress1.Value = "Salaire" Then
salaire.Value = salaire.Value + 1
Else
If ress1.Value = "ASSEDIC" Then
assedic.Value = assedic.Value + 1
Else
If ress1.Value = "RSA" Then
RSA.Value = RSA.Value + 1
Else
If ress1.Value = "Pension alimentaire" Then
PensionAlim.Value = PensionAlim.Value + 1
Else
If ress1.Value = "Indemnités Journalières" Then
IJ.Value = IJ.Value + 1
Else
If ress1.Value = "CAF" Then
CAF.Value = CAF.Value + 1
Else
If ress1.Value = "Pension d'invalidité" Or ress1.Value = "AAH" Then
PIAAH.Value = PIAAH.Value + 1
Else
If ress1.Value = "MVA" Then
MVA.Value = MVA.Value + 1
Else
If ress1.Value = "Retraite" Then
retr.Value = retr.Value + 1
Else
If ress1.Value = "Sans" Then
sans.Value = sans.Value + 1
Else
If ress1.Value = "En attente" Then
attente.Value = attente.Value + 1
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
If ress2.Value = "Salaire" Then
salaire.Value = salaire.Value + 1
Else
If ress2.Value = "ASSEDIC" Then
assedic.Value = assedic.Value + 1
Else
If ress2.Value = "RSA" Then
RSA.Value = RSA.Value + 1
Else
If ress2.Value = "Pension alimentaire" Then
PensionAlim.Value = PensionAlim.Value + 1
Else
If ress2.Value = "Indemnités Journalières" Then
IJ.Value = IJ.Value + 1
Else
If ress2.Value = "CAF" Then
CAF.Value = CAF.Value + 1
Else
If ress2.Value = "Pension d'invalidité" Or ress2.Value = "AAH" Then
PIAAH.Value = PIAAH.Value + 1
Else
If ress2.Value = "MVA" Then
MVA.Value = MVA.Value + 1
Else
If ress2.Value = "Retraite" Then
retr.Value = retr.Value + 1
Else
If ress2.Value = "Sans" Then
sans.Value = sans.Value + 1
Else
If ress2.Value = "En attente" Then
attente.Value = attente.Value + 1
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If

'Logement
Set logpublic = Resultats.Range("AF" & m)
Set logprive = Resultats.Range("AG" & m)
Set heberge = Resultats.Range("AH" & m)
Set logccas = Resultats.Range("AI" & m)
Set autrelog = Resultats.Range("AJ" & m)
If logement.Value = "Parc Privé" Then
logprive.Value = logprive.Value + 1
Else
If logement.Value = "Office Public" Then
logpublic.Value = logpublic.Value + 1
Else
If logement.Value = "Hébergé" Then
heberge.Value = heberge.Value + 1
Else
If logement.Value = "Logement CCAS" Then
logccas.Value = logccas.Value + 1
Else
autrelog.Value = autrelog.Value + 1
End If
End If
End If
End If

'Décisions
Set st = Resultats.Range("AK" & m)
Set se = Resultats.Range("AL" & m)
Set scb = Resultats.Range("AM" & m)
Set ts = Resultats.Range("AN" & m)
Set edf = Resultats.Range("AO" & m)
Set gaz = Resultats.Range("AP" & m)
Set avq = Resultats.Range("AQ" & m)
Set mutuelle = Resultats.Range("AR" & m)
Set auberge = Resultats.Range("AS" & m)
If dec1.Value = "Secours tiers" Then
st.Value = st.Value + 1
Else
If dec1.Value = "Secours espèces" Then
se.Value = se.Value + 1
Else
If dec1.Value = "Secours compte bancaire" Then
scb.Value = scb.Value + 1
Else
If dec1.Value = "Tickets service" Then
ts.Value = ts.Value + 1
Else
If dec1.Value = "EDF" Then
edf.Value = edf.Value + 1
Else
If dec1.Value = "Gaz" Then
gaz.Value = gaz.Value + 1
Else
If dec1.Value = "AVQ" Then
avq.Value = avq.Value + 1
Else
If dec1.Value = "Mutuelle" Then
mutuelle.Value = mutuelle.Value + 1
Else
If dec1.Value = "Repas Auberge" Then
auberge.Value = auberge.Value + 1
End If
End If
End If
End If
End If
End If
End If
End If
End If
If dec2.Value <> "" Then
If dec2.Value = "Secours tiers" Then
st.Value = st.Value + 1
Else
If dec2.Value = "Secours espèces" Then
se.Value = se.Value + 1
Else
If dec2.Value = "Secours compte bancaire" Then
scb.Value = scb.Value + 1
Else
If dec2.Value = "Tickets service" Then
ts.Value = ts.Value + 1
Else
If dec2.Value = "EDF" Then
edf.Value = edf.Value + 1
Else
If dec2.Value = "Gaz" Then
gaz.Value = gaz.Value + 1
Else
If dec2.Value = "AVQ" Then
avq.Value = avq.Value + 1
Else
If dec2.Value = "Mutuelle" Then
mutuelle.Value = mutuelle.Value + 1
Else
If dec2.Value = "Repas Auberge" Then
auberge.Value = auberge.Value + 1
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If

...
...
...

End If

Next j

End sub

En fait j'ai mis les mois de janvier et février mais après il doit y avoir tous les mois jusqu'à décembre.
Cette procédure doit compter le nombre d'occurence de chaque valeur des variables (sexe, situation familiale, ...) en fonction du mois. Dans mon tableau j'ai une colonne "mois".

pijaku Messages postés 12263 Date d'inscription Statut Modérateur Dernière intervention 2 761

Cette procédure doit compter le nombre d'occurence de chaque valeur des variables (sexe, situation familiale, ...) en fonction du mois Pourquoi vouloir une procédure VBA alors que, il me semble, tout ceci est faisable par des formules ou par Tableau Croisé Dynamique?

Réponse 3 / 6

Chtitmiss

Parce qu'il y a un tableau qui a déjà été créé pour accueillir les valeurs calculées et que la procédure permet de mettre les chiffres directement aux emplacements prévus.

Réponse 4 / 6

Chtitmiss

Du coup je peux faire comment ?

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question

Réponse 5 / 6

pijaku Messages postés 12263 Date d'inscription Statut Modérateur Dernière intervention 2 761

Pour :
Peut être alors en utilisant des :
Application.WorksheetFunction.CountIf(Range(plage), donnees)
Regarde, cette procédure devrait te compter le nombre de femmes et d'hommes :
Au lieu de :

Dim Donnees As Worksheet 
Dim Resultats As Worksheet 
Set Donnees = ActiveWorkbook.Worksheets("Donnees") 
Set Resultats = ActiveWorkbook.Worksheets("Resultats") 
Dim Sexe As Range 
Dim fem As Range 
Dim hom As Range
If mois.Value = "Janvier" Then 
m = 3 
'Sexe 
Set Sexe = Donnees.Range("C" & j) 
Set fem = Resultats.Range("C" & m) 
Set hom = Resultats.Range("B" & m) 
If Sexe.Value = "F" Then 
fem.Value = fem.Value + 1 
Else 
If Sexe.Value = "M" Then 
hom.Value = hom.Value + 1 
End If 
End If

Tu mets :

Sub CompterFemmesHommes()
'Déclaration des variables
Dim m As Integer
Dim DernLig As Long
'on détermine la dernière ligne de la colonne A et on stocke son numéro dans la variable DernLig
DernLig = Sheets("Donnees").Range("A65536").End(xlUp).Row
If mois.Value = "Janvier" Then 
m = 3
'Dans la feuille "Resultats"
With Sheets("Resultats")
'La cellule C3 (3 est fonction du mois variable m) est égale au nombre de
' cellules de la feuilles Donnees, colonne C qui contiennent "F"
    .Range("C" & m) = Application.WorksheetFunction.CountIf(Sheets("Donnees").Range("C1:C" & DernLig), "F")
    .Range("B" & m) = Application.WorksheetFunction.CountIf(Sheets("Donnees").Range("C1:C" & DernLig), "H")
End With
End Sub

Teste ça et reviens nous voir.

Réponse 6 / 6

ccm81 Messages postés 10909 Date d'inscription Statut Membre Dernière intervention 2 433

bonjour
1. Au vu du code, il doit y avoir moyen de le raccourcir, en particulier, tous ces "if then else " imbriqués peuvent être avantageusement remplacés par des "select case" plus économiques et nettement plus lisibles
2. Tu peux aussi couper la procedure Resultats en plusieurs sous procedures
3. Je crois que de toutes façons, si tu veux un coup de main plus complet, il te faudra envoyer le fichier (sans données confidentielles, mais avec quelques données) sur cijoint.fr au format excel 2003 pour qu'on puisse appliquer
bonne suite

Chtitmiss

Merci beaucoup ! Du coup j'ai utilisé les "select case" et j'ai trouvé une façon pour pas avoir a répéter pour chaque mois.

For j = 2 To i

Set mois = Donnees.Range("B" & j)
Set Sexe = Donnees.Range("C" & j)
Set sitfam = Donnees.Range("E" & j)
Set nbenf = Donnees.Range("F" & j)
Set age = Donnees.Range("D" & j)
Set act1 = Donnees.Range("G" & j)
Set act2 = Donnees.Range("H" & j)
Set ress1 = Donnees.Range("I" & j)
Set ress2 = Donnees.Range("J" & j)
Set logement = Donnees.Range("K" & j)
Set dec1 = Donnees.Range("L" & j)
Set dec2 = Donnees.Range("M" & j)

Select Case mois.Value
Case "Janvier"
m = 3
Case "Février"
m = 4
Case "Mars"
m = 5
Case "Avril"
m = 6
Case "Mai"
m = 7
Case "Juin"
m = 8
Case "Juillet"
m = 9
Case "Août"
m = 10
Case "Septembre"
m = 11
Case "Octobre"
m = 12
Case "Novembre"
m = 13
Case "Décembre"
m = 14
End Select

'Sexe
Set fem = Resultats.Range("C" & m)
Set hom = Resultats.Range("B" & m)
Select Case Sexe.Value
Case "F"
fem.Value = fem.Value + 1
Case "M"
hom.Value = hom.Value + 1
End Select

'Situation familiale
Set celib = Resultats.Range("E" & m)
Set coupleseul = Resultats.Range("F" & m)
Set persavecenf = Resultats.Range("G" & m)
Set coupleenf = Resultats.Range("H" & m)
Select Case nbenf.Value
Case 0
Select Case sitfam.Value
Case "Seul"
celib.Value = celib.Value + 1
Case "Couple"
coupleseul.Value = coupleseul.Value + 1
End Select
Case Is > 0
Select Case sitfam.Value
Case "Seul"
persavecenf.Value = persavecenf.Value + 1
Case "Couple"
coupleenf.Value = coupleenf.Value + 1
End Select
End Select

'Age
Set moins25 = Resultats.Range("I" & m)
Set entre2534 = Resultats.Range("J" & m)
Set entre3544 = Resultats.Range("K" & m)
Set entre4554 = Resultats.Range("L" & m)
Set entre5564 = Resultats.Range("M" & m)
Set plus65 = Resultats.Range("N" & m)
Select Case age.Value
Case "<25"
moins25.Value = moins25.Value + 1
Case "25/34"
entre2534.Value = entre2534.Value + 1
Case "35/44"
entre3544.Value = entre3544.Value + 1
Case "45/54"
entre4554.Value = entre4554.Value + 1
Case "55/64"
entre5564.Value = entre5564.Value + 1
Case ">65"
plus65.Value = plus65.Value + 1
End Select

'Activité
Set salarie = Resultats.Range("O" & m)
Set ddemploi = Resultats.Range("P" & m)
Set amm = Resultats.Range("Q" & m)
Set inval = Resultats.Range("R" & m)
Set retraite = Resultats.Range("S" & m)
Set autre = Resultats.Range("T" & m)
Select Case act1.Value
Case "Salarié"
salarie.Value = salarie.Value + 1
Case "Demandeur d'emploi"
ddemploi.Value = ddemploi.Value + 1
Case "Arrêt maladie"
amm.Value = amm.Value + 1
Case "Invalidité"
inval.Value = inval.Value + 1
Case "Retraité"
retraite.Value = retraite.Value + 1
Case Else
autre.Value = autre.Value + 1
End Select
Select Case act2.Value
Case Is <> ""
Select Case act2.Value
Case "Salarié"
salarie.Value = salarie.Value + 1
Case "Demandeur d'emploi"
ddemploi.Value = ddemploi.Value + 1
Case "Arrêt maladie"
amm.Value = amm.Value + 1
Case "Invalidité"
inval.Value = inval.Value + 1
Case "Retraité"
retraite.Value = retraite.Value + 1
Case Else
autre.Value = autre.Value + 1
End Select
End Select

'Ressources
Set salaire = Resultats.Range("U" & m)
Set assedic = Resultats.Range("V" & m)
Set RSA = Resultats.Range("W" & m)
Set PensionAlim = Resultats.Range("X" & m)
Set IJ = Resultats.Range("Y" & m)
Set CAF = Resultats.Range("Z" & m)
Set PIAAH = Resultats.Range("AA" & m)
Set MVA = Resultats.Range("AB" & m)
Set retr = Resultats.Range("AC" & m)
Set sans = Resultats.Range("AD" & m)
Set attente = Resultats.Range("AE" & m)
Select Case ress1.Value
Case "Salaire"
salaire.Value = salaire.Value + 1
Case "ASSEDIC"
assedic.Value = assedic.Value + 1
Case "RSA"
RSA.Value = RSA.Value + 1
Case "Pension alimentaire"
PensionAlim.Value = PensionAlim.Value + 1
Case "Indemnités Journalières"
IJ.Value = IJ.Value + 1
Case "CAF"
CAF.Value = CAF.Value + 1
Case "Pension d'invalidité"
PIAAH.Value = PIAAH.Value + 1
Case "AAH"
PIAAH.Value = PIAAH.Value + 1
Case "MVA"
MVA.Value = MVA.Value + 1
Case "Retraite"
retr.Value = retr.Value + 1
Case "Sans"
sans.Value = sans.Value + 1
Case "En attente"
attente.Value = attente.Value + 1
End Select
Select Case ress2.Value
Case "Salaire"
salaire.Value = salaire.Value + 1
Case "ASSEDIC"
assedic.Value = assedic.Value + 1
Case "RSA"
RSA.Value = RSA.Value + 1
Case "Pension alimentaire"
PensionAlim.Value = PensionAlim.Value + 1
Case "Indemnités Journalières"
IJ.Value = IJ.Value + 1
Case "CAF"
CAF.Value = CAF.Value + 1
Case "Pension d'invalidité"
PIAAH.Value = PIAAH.Value + 1
Case "AAH"
PIAAH.Value = PIAAH.Value + 1
Case "MVA"
MVA.Value = MVA.Value + 1
Case "Retraite"
retr.Value = retr.Value + 1
Case "Sans"
sans.Value = sans.Value + 1
Case "En attente"
attente.Value = attente.Value + 1
End Select

'Logement
Set logpublic = Resultats.Range("AF" & m)
Set logprive = Resultats.Range("AG" & m)
Set heberge = Resultats.Range("AH" & m)
Set logccas = Resultats.Range("AI" & m)
Set autrelog = Resultats.Range("AJ" & m)
Select Case logement.Value
Case "Parc Privé"
logprive.Value = logprive.Value + 1
Case "Office Public"
logpublic.Value = logpublic.Value + 1
Case "Hébergé"
heberge.Value = heberge.Value + 1
Case "Logement CCAS"
logccas.Value = logccas.Value + 1
Case Else
autrelog.Value = autrelog.Value + 1
End Select

'Décisions
Set st = Resultats.Range("AK" & m)
Set se = Resultats.Range("AL" & m)
Set scb = Resultats.Range("AM" & m)
Set ts = Resultats.Range("AN" & m)
Set edf = Resultats.Range("AO" & m)
Set gaz = Resultats.Range("AP" & m)
Set avq = Resultats.Range("AQ" & m)
Set mutuelle = Resultats.Range("AR" & m)
Set auberge = Resultats.Range("AS" & m)
Select Case dec1.Value
Case "Secours tiers"
st.Value = st.Value + 1
Case "Secours espèces"
se.Value = se.Value + 1
Case "Secours compte bancaire"
scb.Value = scb.Value + 1
Case "Tickets service"
ts.Value = ts.Value + 1
Case "EDF"
edf.Value = edf.Value + 1
Case "Gaz"
gaz.Value = gaz.Value + 1
Case "AVQ"
avq.Value = avq.Value + 1
Case "Mutuelle"
mutuelle.Value = mutuelle.Value + 1
Case "Repas Auberge"
auberge.Value = auberge.Value + 1
End Select
Select Case dec2.Value
Case Is <> ""
Select Case dec2.Value
Case "Secours tiers"
st.Value = st.Value + 1
Case "Secours espèces"
se.Value = se.Value + 1
Case "Secours compte bancaire"
scb.Value = scb.Value + 1
Case "Tickets service"
ts.Value = ts.Value + 1
Case "EDF"
edf.Value = edf.Value + 1
Case "Gaz"
gaz.Value = gaz.Value + 1
Case "AVQ"
avq.Value = avq.Value + 1
Case "Mutuelle"
mutuelle.Value = mutuelle.Value + 1
Case "Repas Auberge"
auberge.Value = auberge.Value + 1
End Select
End Select

Next j

Procédure trop grande en VBA

6 réponses

Votre réponse

Discussions similaires