Rassembler deux code en un seul
Bonjour le forum
j'aimerais que mes deux code ci joint ne forme qu'un seul code j'ai fait un autre code mais sa me renvoie la mm chose
voici mes code:
Sub NOMBRE_DE_SINISTRES_DECLARES()
Dim Date_Souscription_Adhésion As Range, Date_Survenance As Range
Dim DernLigne As Long
Dim nblignes(1 To 12, 2013 To 2017) As Long
Dim i, j, k As Integer
Dim a, b, c, d, e As Integer
With Worksheets("Sinistre_Historique")
DernLigne = .Range("A" & .Rows.Count).End(xlUp).Row
Set Date_Souscription_Adhésion = .Range("G2:G" & DernLigne)
Set Date_Survenance = .Range("U2:U" & DernLigne)
End With
a = LBound(nblignes, 2)
e = UBound(nblignes, 2)
For i = 2 To DernLigne
If a <= Year(Cells(i, 21).Value) And Year(Cells(i, 21).Value) <= e Then
j = Month(Cells(i, 7).Value)
k = Year(Cells(i, 7).Value)
nblignes(j, k) = nblignes(j, k) + 1
End If
Next i
For i = 1 To 12
For k = a To e
Sheets("Feuil1").Cells(i + (k - 2013) * 12, 3).Value = nblignes(i, k)
Next k
Next i
End Sub
Sub NOMBRE_DE_SINISTRES_ACCEPTES()
Dim Date_Souscription_Adhésion As Range, Date_Survenance, Statut_Technique_Sinistre As Range
Dim DernLigne As Long
Dim nblignes(1 To 12, 2013 To 2017) As Long
Dim i, j, k As Integer
Dim a, b, c, d, e As Integer
Dim s As String
With Worksheets("Sinistre_Historique")
DernLigne = .Range("A" & .Rows.Count).End(xlUp).Row
Set Date_Souscription_Adhésion = .Range("G2:G" & DernLigne)
Set Date_Survenance = .Range("U2:U" & DernLigne)
Set Statut_Technique_Sinistre = .Range("V2:V" & DernLigne)
End With
a = LBound(nblignes, 2)
e = UBound(nblignes, 2)
For i = 2 To DernLigne
s = Cells(i, "V").Value
If s = "Terminé - accepté" Then
If a <= Year(Cells(i, 21).Value) And Year(Cells(i, 21).Value) <= e Then
j = Month(Cells(i, 7).Value)
k = Year(Cells(i, 7).Value)
nblignes(j, k) = nblignes(j, k) + 1
End If
End If
Next i
For i = 1 To 12
For k = a To e
Sheets("Feuil1").Cells(i + (k - 2013) * 12, 4).Value = nblignes(i, k)
Next k
Next i
End Subet voici le code que j'ai essayé de faire et qu'il me renvoie les même valeurs pour les deux colonne
Sub NOMBRE_DE_SINISTRES_DECLARES()
Dim Date_Souscription_Adhésion As Range, Date_Survenance As Range
Dim Statut_Technique_Sinistre As Range
Dim DernLigne As Long
Dim nblignes(1 To 12, 2013 To 2017) As Long
Dim i, j, k, l, m, n As Integer
Dim a, b, c, d, e As Integer
Dim s As String
With Worksheets("Sinistre_Historique_ICICDDE (3)")
DernLigne = .Range("A" & .Rows.Count).End(xlUp).Row
Set Date_Souscription_Adhésion = .Range("G2:G" & DernLigne)
Set Date_Survenance = .Range("U2:U" & DernLigne)
End With
a = LBound(nblignes, 2)
e = UBound(nblignes, 2)
For i = 2 To DernLigne
If a <= Year(Cells(i, 21).Value) And Year(Cells(i, 21).Value) <= e Then
j = Month(Cells(i, 7).Value)
k = Year(Cells(i, 7).Value)
nblignes(j, k) = nblignes(j, k) + 1
End If
Next i
For l = 2 To DernLigne
s = Cells(l, "V").Value
If s = "Terminé - accepté" Then
If a <= Year(Cells(l, 21).Value) And Year(Cells(l, 21).Value) <= e Then
m = Month(Cells(l, 7).Value)
n = Year(Cells(l, 7).Value)
nblignes(m, n) = nblignes(m, n) + 1
End If
End If
Next l
For i = 1 To 12
For k = a To e
'condition is si numero contrat fichier tdb = numero police fichier sinistre
'changer sheets et mettre la bonne feuille
'condition sur mois et année pour pouvoir effectuer les macros
Sheets("Feuil1").Cells(i + (k - 2013) * 12, 3).Value = nblignes(i, k)
Next k
Next i
For l = 1 To 12
For n = a To e
Sheets("Feuil1").Cells(l + (n - 2013) * 12, 4).Value = nblignes(l, n)
Next n
Next l
End Subci joint le fichier
re-bonjour
je suppose que c'est impossible a faire
Bonjour,
je suppose que c'est impossible a faire
Mauvaise déduction... !
Mais si tu utilises le même tableau à 2 dimensions pour y placer deux fois plus de valeurs, cela ne paraît guère compatible ! Il faut doubler le tableau avec une 3e dimension...
En outre tu ne fais que répéter les deux procédures... Pour que la nouvelle représente un gain, il faut réduire les deux boucles àune seule.
Et une affectation en tableau serait certainement préférable, de même que rendre plus générique la procédure en ne la bloquant pas sur des années prédéfinies...
Cordialement.
merci pour ton aide
comment je pourrais réduire les deux boucles a une seule
En n'opérant qu'un seul parcours ! Et à chaque tour tu peux faire les deux opérations, d'autant que les conditions de dates et le mois et l'année sont commun, ce qui fait autant d'économisé. Il n'y a qu'une condition supplémentaire pour une opération.
Voilà la fusion des 2 procédures...
Sub NombreSinistres(a0 As Integer, a1 As Integer)
Dim Tdécla(), Taccept(), dln&, i&, a%, m%
ReDim Tdécla(12, a0 - 1 To a1): ReDim Taccept(12, a0 - 1 To a1)
With Worksheets("Sinistre_Historique")
dln = .Range("A" & .Rows.Count).End(xlUp).Row
For i = 2 To dln
a = Year(.Cells(i, 21))
If a >= a0 And a <= a1 Then
a = Year(.Cells(i, 7)): m = Month(.Cells(i, 7))
Tdécla(m, a) = Tdécla(m, a) + 1
If .Cells(i, 22).Value Like "*accepté*" Then
Taccept(m, a) = Taccept(m, a) + 1
End If
End If
Next i
End With
For i = 1 To 12
Tdécla(i, a0 - 1) = MonthName(i): Taccept(i, a0 - 1) = MonthName(i)
Next i
For i = a0 To a1
Tdécla(0, i) = i: Taccept(0, i) = i
Next i
a = a1 - a0 + 2
With Worksheets("Feuil1")
With .UsedRange
.ClearContents
.Borders.LineStyle = xlLineStyleNone
.MergeCells = False
.HorizontalAlignment = xlLeft
End With
With .Cells(1, 1)
.Value = "Nombre de sinistres déclarés"
With .Resize(, a)
.Merge
.HorizontalAlignment = xlCenter
End With
End With
With .Cells(2, 1).Resize(13, a)
.Value = Tdécla
.Columns.AutoFit
With .Borders
.LineStyle = xlContinuous: Weight = xlThin
End With
.Offset(, 1).HorizontalAlignment = xlCenter
End With
With .Cells(1, a + 2)
.Value = "Nombre de sinistres acceptés"
With .Resize(, a)
.Merge
.HorizontalAlignment = xlCenter
End With
End With
With .Cells(2, a + 2).Resize(13, a)
.Value = Taccept
.Columns.AutoFit
With .Borders
.LineStyle = xlContinuous: Weight = xlThin
End With
.Offset(, 1).HorizontalAlignment = xlCenter
End With
.Activate
End With
End Sub
Sub Test()
NombreSinistres 2013, 2017
End SubBouton sur feuille Hisorique.
On constitue les deux tableaux simultanément.
Cela raccourcit assez nettement... A partir du moment où l'on passe sur la feuille1, l'affectation occupe 2 lignes et tout le reste du code n'est que la mise en forme des tableaux.
La variabilité des années prélevées est assurée par une procédure de lancement (appelée Test ici), qui lance la procédure en lui passant l'année début et l'année fin. C'est là qu'on les change s'il y a lieu.
Cordialement.
ouahhh c magnifiqueee
je comprend pas pourquoi il n'y a pas as quelque chose
Dim Tdécla(), Taccept(), dln&, i&, a%, m%Il n'y a pas quoi ?
Tu ne me dis pas ce qui semble te manquer ?
je comprend pas pourquoi il y a pas as integer, double ...
Ah !
Ces caractères accolés à un nom de variable sont ce que l'on appelle des caractères de déclaration de type.
Il y en a quelques autres pour Single, Double, Currency et String.
Cela permet de raccourcir assez sensiblement les déclarations.
Les tableaux sont déclarés en tableaux dynamiques (le nombre d'années pouvant varier) et sont de dimensionnés à l'exécution (avec ReDim). De type Variant (quand on n'indique pas de type, la variable est de type Variant, note que dans tes déclarations de groupe où tu listes des variables et n'indique qu'une fois le type à la fin, seule la dernière est alors typée, les autres sont Variant car toutes les variables doivent se typer individuellement...) pour accueillir des types de données différents.
ah d’accord
encore mercii pour toute tes explications