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 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73
| Sub ()
Dim TD As Variant 'déclare la variable TD (Tableau des Données)
Dim CL3 As Workbook 'déclare la variable CL3 (CLasseur3)
Dim I As Integer 'déclare la variable I (Incrément)
Dim D As Date 'déclare la variable D (Date)
Dim O2 As Worksheet 'déclare la variable O2 (Onglet 2)
Dim TC As Variant 'déclare la variable TC (Tableau de Cellules)
Dim J As Integer 'déclare la variable J (incrément)
Dim TEST As Boolean 'déclare la variable TEST
Dim MES As String 'déclare la variable MES (MESage)
ActiveCell.Select 'enlève le focus au bouton
Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
TD = Range("A6:A" & Range("A" & Rows.Count).End(xlUp).Row).Resize(, 8) 'définit le tableau de données TD
On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
Set CL3 = Workbooks("Calcul 2.2.xls") 'définit le classeur CL3 (génère une erreur si ce classeur n'est pas ouvert)
If Err <> 0 Then 'condition : si une erreur a été générée
Err.Clear 'supprime l'erreur
MsgBox "Le classeur " & Chr(34) & "Calcul 2.2.xls" & Chr(34) & " n'est pas ouvert ! Veuillez l'ouvrir." 'message
Exit Sub 'sort de la procédure
End If 'fin de la condition
On Error GoTo 0 'annule la gestion des erreurs
For I = 1 To UBound(TD, 1) 'boucle 1 : sur toutes les lignes I du tableau de données TD
If TD(I, 5) = "" Then 'condition 1 : si la valeur en colonne 5 (=E) est vide
TEST = False 'définit la variable TEST
If IsDate(TD(I, 1)) = False Then 'condition : si la date en ligne I colonne 1 de TD n'est pas valide
MsgBox "Date non valide !Veuillez recommencer." 'message
Cells(I + 5, 1).ClearContents 'efface le contenu de la cellule correspondante en colonne A
Cells(I + 5, 1).Select 'sélectionne la cellule correspondante en colonne A
Exit Sub 'sort de la procédure
End If 'fin de la condition
D = TD(I, 1) 'définit la date D
On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
Set O2 = CL3.Sheets(TD(I, 3)) 'définit l'onglet O2 (génère une erreur si cet onglet n'existe pas)
If Err <> 0 Then 'condition 2 : si une erreur a été générée
Err.Clear 'supprime l'erreur
MES = IIf(TD(I, 3) = "", "Maturité non renseignée ! Voulez-vous continuer ?", "L'onglet " & _
Chr(34) & TD(I, 3) & Chr(34) & " n'existe pas ! Voulez-vous continuer ?") 'définit le message MES
If MsgBox(MES, vbYesNo, "ATTENTION !") = vbNo Then 'condition 3 : si "Non" au message
Cells(I + 5, 3).ClearContents 'efface le contenu de la cellule correspondante en colonne C
Cells(I + 5, 3).Select 'sélectionne la cellule correspondante en colonne C
Exit Sub 'sort de la procédure
Else 'sinon (si "Oui" au messsage)
GoTo Suite 'va à l'étiquette "Suite"
End If 'fin de la condition 3
End If 'fin de la condition 2
On Error GoTo 0 'annule la gestion des erreurs
TC = O2.Range("A13").CurrentRegion '.Resize(, 4) 'définit le tableau de cellules TC
O2.Range("B1").Value = D 'renvoie la date D dans la cellue B1 de l'onglet O2
For J = 2 To UBound(TC, 1) 'boucle 2 : sur toutes les lignes J du tableau de cellules TC (en partant de la seconde)
'condition 4 : si la valeur du taux 1 (ligne I colonne 8 de TD) est égale à la valeur ligne J colonne 1 de TC
If CStr(TD(I, 8)) = CStr(TC(J, 1)) Then
TEST = True 'définit la variable TEST
Cells(I + 5, 6).Value = TC(J, 3) 'récupère en colonne F la valeur ligne J colonne 3 de TC
Cells(I + 5, 6).NumberFormat = "0.000%" 'format de la cellule
Cells(I + 5, 7).Value = TC(J, 4) 'récupère en colonne G la valeur ligne J colonne 4 de TC
Cells(I + 5, 7).NumberFormat = "0.00000000%" 'format de la cellule
Erase TC 'efface le tableau de cellules TC
Exit For 'sort de la boucle 2
End If 'fin de la condition 4
Next J 'prochaine ligne de la boucle 2
If TEST = False Then 'condition 5 : si TEST est [Faux]
MsgBox "Aucune valeur correspondant au Taux 1 n'a été trouvée pour la ligne " & I + 5 & " !" 'message
Cells(I + 5, 8).Interior.ColorIndex = 3 'colore la cellule du Taux 1 de rouge
End If 'fin de la condition 5
End If 'fin de la condition 1
Suite: 'étiquette
Next I 'prochaine ligne de la boucle 1
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
End Sub |
Partager