Réduire code VBA
a
Rebonjour
comment je peux réduire mon code vba svp
j'arrive pas en effectuant une boucles
merci
Sub MONTANT_INDEMNITE_PRINCIPALE()
Dim Date_Souscription_Adhésion As Range, Statut_Technique_Sinistre As Range
Dim Montant_Ind_Principale As Range
Dim dernligne As Long
Dim i As Integer
Dim sa As String
Dim montant As String
Dim tt1, tt2, tt3, tt4, tt5, tt6, tt7, tt8, tt9, tt10, tt11, tt12 As Double
Dim t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12 As Double
'Dim tt13, tt14, tt15, tt16, tt17, tt18, tt19, tt20, tt21, tt22, tt23, tt24 As Double
Dim tt25, tt26, tt27, tt28, tt29, tt30, tt31, tt32, tt33, tt34, tt35, tt36 As Double
Dim s As Double
Dim Mois As Integer
With Worksheets("Feuil1")
dernligne = .Range("A" & Rows.Count).End(xlUp).Row
Set Date_Souscription_Adhésion = .Range("B2:B" & dernligne)
Set Montant_Ind_Principale = .Range("E2:E" & dernligne)
Set Statut_Technique_Sinistre = .Range("D2:D" & dernligne)
End With
i = 2
For i = 2 To dernligne
sa = Cells(i, 4)
montant = Cells(i, 5)
Mois = Month(Cells(i, 2))
If sa <> "Terminé - Refusé après instruction" Then
If Year(Cells(i, 2).Value) = 2015 Then
Select Case Mois
Case Is = 1
tt1 = tt1 + CInt(montant)
Case Is = 2
tt2 = tt2 + CInt(montant)
Case Is = 3
tt3 = tt3 + CInt(montant)
Case Is = 4
tt4 = tt4 + CInt(montant)
Case Is = 5
tt5 = tt5 + CInt(montant)
Case Is = 6
tt6 = tt6 + CInt(montant)
Case Is = 7
tt7 = tt7 + CInt(montant)
Case Is = 8
tt8 = tt8 + CInt(montant)
Case Is = 9
tt9 = tt9 + CInt(montant)
Case Is = 10
tt10 = tt10 + CInt(montant)
Case Is = 11
tt11 = tt11 + CInt(montant)
Case Is = 12
tt12 = tt12 + CInt(montant)
End Select
End If
If Year(Cells(i, 2).Value) = 2016 Then
Select Case Mois
Case Is = 1
t1 = t1 + CInt(montant)
Case Is = 2
t2 = t2 + CInt(montant)
Case Is = 3
t3 = t3 + CInt(montant)
Case Is = 4
t4 = t4 + CInt(montant)
Case Is = 5
t5 = t5 + CInt(montant)
Case Is = 6
t6 = t6 + CInt(montant)
Case Is = 7
t7 = t7 + CInt(montant)
Case Is = 8
t8 = t8 + CInt(montant)
Case Is = 9
t9 = t9 + CInt(montant)
Case Is = 10
t10 = t10 + CInt(montant)
Case Is = 11
t11 = t11 + CInt(montant)
Case Is = 12
t12 = t12 + CInt(montant)
End Select
End If
If Year(Cells(i, 2).Value) = 2017 Then
Select Case Mois
Case Is = 25
tt25 = tt25 + CInt(montant)
Case Is = 26
tt26 = tt26 + CInt(montant)
Case Is = 27
tt27 = tt27 + CInt(montant)
Case Is = 28
tt28 = tt28 + CInt(montant)
Case Is = 29
tt29 = tt29 + CInt(montant)
Case Is = 30
tt30 = tt30 + CInt(montant)
Case Is = 31
tt31 = tt31 + CInt(montant)
Case Is = 32
tt32 = tt32 + CInt(montant)
Case Is = 33
tt33 = tt33 + CInt(montant)
Case Is = 34
tt34 = tt34 + CInt(montant)
Case Is = 35
tt35 = tt35 + CInt(montant)
Case Is = 36
tt36 = tt36 + CInt(montant)
End Select
End If
End If
Sheets("Feuil2").Cells(1, 2).Value = "janvier 2015"
Sheets("Feuil2").Cells(1, 3).Value = tt1
Sheets("Feuil2").Cells(2, 2).Value = "fevrier 2015"
Sheets("Feuil2").Cells(2, 3).Value = tt2
Sheets("Feuil2").Cells(3, 2).Value = "mars 2015"
Sheets("Feuil2").Cells(3, 3).Value = tt3
Sheets("Feuil2").Cells(4, 2).Value = "avril 2015"
Sheets("Feuil2").Cells(4, 3).Value = tt4
Sheets("Feuil2").Cells(5, 2).Value = "mai 2015"
Sheets("Feuil2").Cells(5, 3).Value = tt5
Sheets("Feuil2").Cells(6, 2).Value = "juin 2015"
Sheets("Feuil2").Cells(6, 3).Value = tt6
Sheets("Feuil2").Cells(7, 2).Value = "juil 2015"
Sheets("Feuil2").Cells(7, 3).Value = tt7
Sheets("Feuil2").Cells(8, 2).Value = "aout 2015"
Sheets("Feuil2").Cells(8, 3).Value = tt8
Sheets("Feuil2").Cells(9, 2).Value = "sept 2015"
Sheets("Feuil2").Cells(9, 3).Value = tt9
Sheets("Feuil2").Cells(10, 2).Value = "oct 2015"
Sheets("Feuil2").Cells(10, 3).Value = tt10
Sheets("Feuil2").Cells(11, 2).Value = "nov 2015"
Sheets("Feuil2").Cells(11, 3).Value = tt11
Sheets("Feuil2").Cells(12, 2).Value = "dec 2015"
Sheets("Feuil2").Cells(12, 3).Value = tt12
Sheets("Feuil2").Cells(13, 2).Value = "janvier 2016"
Sheets("Feuil2").Cells(13, 3).Value = t1
Sheets("Feuil2").Cells(14, 2).Value = "fevrier 2016"
Sheets("Feuil2").Cells(14, 3).Value = t2
Sheets("Feuil2").Cells(15, 2).Value = "mars 2016"
Sheets("Feuil2").Cells(15, 3).Value = t3
Sheets("Feuil2").Cells(16, 2).Value = "avril 2016"
Sheets("Feuil2").Cells(16, 3).Value = t4
Sheets("Feuil2").Cells(17, 2).Value = "mai 2016"
Sheets("Feuil2").Cells(17, 3).Value = t5
Sheets("Feuil2").Cells(18, 2).Value = "juin 2016"
Sheets("Feuil2").Cells(18, 3).Value = t6
Sheets("Feuil2").Cells(19, 2).Value = "juil 2016"
Sheets("Feuil2").Cells(19, 3).Value = t7
Sheets("Feuil2").Cells(20, 2).Value = "aout 2016"
Sheets("Feuil2").Cells(20, 3).Value = t8
Sheets("Feuil2").Cells(21, 2).Value = "sept 2016"
Sheets("Feuil2").Cells(21, 3).Value = t9
Sheets("Feuil2").Cells(22, 2).Value = "oct 2016"
Sheets("Feuil2").Cells(22, 3).Value = t10
Sheets("Feuil2").Cells(23, 2).Value = "nov 2016"
Sheets("Feuil2").Cells(23, 3).Value = t11
Sheets("Feuil2").Cells(24, 2).Value = "dec 2016"
Sheets("Feuil2").Cells(24, 3).Value = t12
'refaire la mm chose pour 2017
Next i
End Subbonjour,
à tester
Sub MONTANT_INDEMNITE_PRINCIPALE()
Dim Date_Souscription_Adhésion As Range, Statut_Technique_Sinistre As Range
Dim Montant_Ind_Principale As Range
Dim dernligne As Long
Dim i As Integer
Dim sa As String
Dim montant As String
Dim tt(2015 To 2017, 1 To 12) As Double
tmois = Split("janvier,février,mars,avril,mai,juin,juillet,août,septembre,octobre,novembre,décembre", ",")
With Worksheets("Feuil1")
dernligne = .Range("A" & Rows.Count).End(xlUp).Row
Set Date_Souscription_Adhésion = .Range("B2:B" & dernligne)
Set Montant_Ind_Principale = .Range("E2:E" & dernligne)
Set Statut_Technique_Sinistre = .Range("D2:D" & dernligne)
For i = 2 To dernligne
sa = .Cells(i, 4)
montant = .Cells(i, 5)
annee = Year(.Cells(i, 2).Value)
Mois = Month(.Cells(i, 2))
If sa <> "Terminé - Refusé après instruction" Then
tt(annee, Mois) = tt(annee, Mois) + CDbl(montant)
End If
Next i
For annee = 2015 To 2017
For Mois = 1 To 12
j = j + 1
Sheets("Feuil2").Cells(j, 2).Value = tmois(Mois - 1) & " " & annee
Sheets("Feuil2").Cells(j, 3).Value = tt(annee, Mois)
Next Mois
Next annee
End With
End Suba
sa marche merciiii
juste une petite question c quoi CDbl ste plais
aude21 a écrit :sa marche merciiii
juste une petite question c quoi CDbl ste plais
cdbl() est un fonction de conversion vers un type double
info ici
a
pourquoi quand je l'applique a mon fichier sa ne veut pas marcher
Sub MONTANT_INDEMNITE_PRINCIPALE()
Dim Date_Souscription_Adhésion As Range, Statut_Technique_Sinistre As Range
Dim Montant_Ind_Principale As Range
Dim dernligne As Long
Dim i As Integer
Dim sa As String
Dim montant As String
Dim tt(2015 To 2017, 1 To 12) As Double
tmois = Split("janvier,février,mars,avril,mai,juin,juillet,août,septembre,octobre,novembre,décembre", ",")
With Worksheets("Sinistre_Historique")
dernligne = .Range("A" & .Rows.Count).End(xlUp).Row
Set Date_Souscription_Adhésion = .Range("G2:G" & dernligne)
Set Montant_Ind_Principale = .Range("AB2:AB" & dernligne)
Set Statut_Technique_Sinistre = .Range("V2:V" & dernligne)
For i = 2 To dernligne
sa = .Cells(i, 22)
montant = .Cells(i, 28)
annee = Year(.Cells(i, 7).Value)
Mois = Month(.Cells(i, 7))
If sa <> "Terminé - Refusé après instruction" Then
tt(annee, Mois) = tt(annee, Mois) + CDbl(montant)
End If
Next i
For annee = 2015 To 2017
For Mois = 1 To 12
j = j + 1
Sheets("Feuil2").Cells(j, 2).Value = tmois(Mois - 1) & " " & annee
Sheets("Feuil4").Cells(j, 6).Value = tt(annee, Mois)
Next Mois
Next annee
End With
End Subil ya une erreur au niveaux de
tt(annee, Mois) = tt(annee, Mois) + CDbl(montant)re-bonjour,
sanston fichier, difficile à dire
vérifie si toutes les données dans la colonne montant sont bien des nombres.
vérifie que l'année de chaque date est bien dans comprise de 2015 à 2017.
a
oui j'ai vérifier y a bien tout ça
je t'ai mis un fichier qui ressemble au mieux
bonjour,
pas de problème chez moi avec ton fichier sur ma version excel UK.
sans doute un problème dû à la différence entre , et . pour le version UK et FR
essaie ceci
Sub MONTANT_INDEMNITE_PRINCIPALE()
Dim Date_Souscription_Adhésion As Range, Statut_Technique_Sinistre As Range
Dim Montant_Ind_Principale As Range
Dim dernligne As Long
Dim i As Integer
Dim sa As String
Dim montant As String
Dim tt(2015 To 2017, 1 To 12) As Double
tmois = Split("janvier,février,mars,avril,mai,juin,juillet,août,septembre,octobre,novembre,décembre", ",")
With Worksheets("Sinistre_Historique")
dernligne = .Range("A" & .Rows.Count).End(xlUp).Row
Set Date_Souscription_Adhésion = .Range("G2:G" & dernligne)
Set Montant_Ind_Principale = .Range("AB2:AB" & dernligne)
Set Statut_Technique_Sinistre = .Range("V2:V" & dernligne)
For i = 2 To dernligne
sa = .Cells(i, 22)
montant = Replace(.Cells(i, 28), ".", ",")
annee = Year(.Cells(i, 7).Value)
Mois = Month(.Cells(i, 7))
If sa <> "Terminé - Refusé après instruction" Then
tt(annee, Mois) = tt(annee, Mois) + CDbl(montant)
End If
Next i
For annee = 2015 To 2017
For Mois = 1 To 12
j = j + 1
Sheets("Feuil2").Cells(j, 2).Value = tmois(Mois - 1) & " " & annee
Sheets("Feuil4").Cells(j, 6).Value = tt(annee, Mois)
Next Mois
Next annee
End With
End Sub