Merlin258413
XLDnaute Occasionnel
Bonjour à tous je me permet de solliciter votre aide dans le cadre d'une optimisation de code.
Ces codes me permettent de sortir 2 etats en TDC (ONGLET ETAT DES FAE attendu et ETAT DES FACTURES)
Ces codes fonctionnent parfaitement mais sont très longs (en temps et peut être aussi en longueur).
Je pense que comme les 2 états sont issus du même tableau, une simplification peut être apportée, mais là j'ai atteint mes limites.
Mon projet en PJ explication
J'ai un onglet "Base" dans cet onglet j'ai aussi un tableau intitulé "base"
Dans cet onglet lorsque je choisis un mois cellule C2 j'ai un code qui est généré.
1- le code va tout d'abord lancer une macro qui se trouve dans le module SUIVI
- Mise à blanc des états intermédiaires (FACTURE et FAE) qui servent à réaliser les TDC
- Section du tableau "Base" et copie sur l'état intermédiaire FAE
- Suppression des colonnes ne correspondant pas au mois sélectionné dans l'état FAE
- Suppression des lignes de cette colonne si j'ai la valeur vide ou ANNULEE
- Sélection de l'état intermédiaire FAE pour une copie dans l'état intermédiaire FACTURE : j'utilise cette étape intermédiaire car je n'aurais pas besoin dans mon état FAE de la colonne facture et dans mon état FACTURE de la colonne Programme
- Traitement de l'état FAE
- Suppression de toutes les valeurs différentes de FAE (à ce stade, je ne peux qu'avoir FAE, FACTURE ou ENCOURS)
- Tri par ordre croissant
- Traitement de l'état FACTURE
- Suppression de toutes les valeurs différentes de FACTURE (à ce stade, je ne peux qu'avoir FAE, FACTURE ou ENCOURS)
- Suppression des colonnes inutiles
- Tri par ordre croissant
- Protection de la feuille
2- Lancement du code MISE EN FORME ne concerne uniquement que la mise en forme de l'état des FAE avant d'obtenir le TDC final "ETAT DES FAE ATTENDU et enfin Actualisation de tous les TDC
En espérant avoir été clair et merci pour toute votre aide
Le fichier étant de 317 ko dépasse la limite du forum de 293 je ne sais pas comment vous le faire parvenir avec un exemple.
J'ai donc enregistré le fichier en xlsx et en le zippant
Si cela peut vous être utile voici le code
Module 1- Sub SUIVI_FAE()
Dim NB_COL, NB_LIG, COMPTEUR, LIGNE As Long
Dim MOIS_CHOISI As String
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
' remise à blanc des ancienne FAE
Sheets("FAE").Range("A1").CurrentRegion.Clear
Sheets("FACTURE").Range("A1").CurrentRegion.Clear
' Copie des nouvelles FAE
Sheets("Base").Select
MOIS_CHOISI = Range("c2").Value
' Déprotéger la feuille
ActiveSheet.Unprotect Password:="ProgSN"
Range("A4").CurrentRegion.Copy
Sheets("FAE").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
' Supprimer toutes les colonnes <> date choisi
NB_COL = Range("A1", Selection.End(xlToRight)).Count
For COMPTEUR = (NB_COL - 3) To 8 Step -1 'il faut partir en arrière
If Cells(1, COMPTEUR) <> MOIS_CHOISI Then
Columns(COMPTEUR).Delete
End If
Next COMPTEUR
NB_LIG = Range("A1", Selection.End(xlDown)).Count
For LIGNE = NB_LIG To 2 Step -1
If Cells(LIGNE, 8) = "" Or Cells(LIGNE, 8) = "ANNULEE" Then Rows(LIGNE).EntireRow.Delete
Next LIGNE
Range("A1").CurrentRegion.Copy
Sheets("FACTURE").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Sheets("FAE").Select
Columns("F:F").EntireColumn.Delete
'Supprimer toutes les lignes <> "FAE"
NB_LIG = Range("A1", Selection.End(xlDown)).Count
For LIGNE = NB_LIG To 2 Step -1
If Cells(LIGNE, 7).Value <> "FAE" Then
Rows(LIGNE).EntireRow.Delete
End If
Next LIGNE
Columns("G:G").EntireColumn.Delete
'Tri du tableau avant de faire le TDC
Range("A1").CurrentRegion.Sort Key1:=Range("C2"), Order1:=xlAscending, Key2:=Range("A2"), Order2:=xlAscending, Header:=True
Sheets("FACTURE").Select
NB_COL = Range("A1", Selection.End(xlToRight)).Count
'Supprimer toutes les lignes <> "FACTURE"
NB_LIG = Range("A1", Selection.End(xlDown)).Count
For LIGNE = NB_LIG To 2 Step -1
If Cells(LIGNE, 8).Value <> "FACTURE" Then
Rows(LIGNE).EntireRow.Delete
End If
Next LIGNE
Columns("H:k").EntireColumn.Delete
Columns("E:E").EntireColumn.Delete
'Tri du tableau avant de faire le TDC
Range("A1").CurrentRegion.Sort Key1:=Range("C2"), Order1:=xlAscending, Key2:=Range("A2"), Order2:=xlAscending, Header:=True
' Protéger la feuille
Sheets("Base").Protect Password:="ProgSN", AllowFiltering:=True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Sheets("Base").Select
End Sub
Module 2-
Sub Mise_En_Forme()
Dim I As Integer, DL As Integer, NbLigne As Integer, PlageTotalGen As String
Sheets("ETAT DES FAE ATTENDU").Select
' Envoyer dans la variable DL le nombre de ligne du tableau
DL = Range("A1").CurrentRegion.Rows.Count
' Effacer le tableau à droite du TCD
Range(Cells(2, 7), Cells(DL, 10)).Clear
' Actualiser le TCD
ActiveWorkbook.RefreshAll
' Envoyer dans la variable DL le nombre de ligne du tableau
DL = Range("A1").CurrentRegion.Rows.Count
' Définir une variable pour les formules de calcul
NbLigne = 0
PlageTotalGen = ""
For I = 2 To DL
' Ecrire la formule en colonne Solde
Cells(I, 9).FormulaR1C1 = "=RC[-3]-RC[-2]-RC[-1]"
' Tester le texte en colonne A et formater si le contenu commence par Total
If Left(Cells(I, 1), 5) = "Total" Then
' Ecrire les formules en colonnes Facturation et Correction
Cells(I, 7).FormulaR1C1 = "=SUM(R[-" & NbLigne & "]C:R[-1]C)"
Cells(I, 8).FormulaR1C1 = "=SUM(R[-" & NbLigne & "]C:R[-1]C)"
Cells(I, 9).FormulaR1C1 = "=SUM(R[-" & NbLigne & "]C:R[-1]C)"
' Définir les références de cellules pour le total général
PlageTotalGen = PlageTotalGen & "R" & I & "C,"
' Tracer les bordures
With Range(Cells(I, 1), Cells(I, 10)).Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Color = RGB(83, 143, 213)
.Weight = xlThin
End With
With Range(Cells(I, 1), Cells(I, 10)).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Color = RGB(83, 143, 213)
.Weight = xlThin
End With
' Mettre en caractères gras
Range(Cells(I, 5), Cells(I, 10)).Font.Bold = True
' Remettre le compteur de ligne pour les formules de calcul à zéro
NbLigne = 0
Else
Ces codes me permettent de sortir 2 etats en TDC (ONGLET ETAT DES FAE attendu et ETAT DES FACTURES)
Ces codes fonctionnent parfaitement mais sont très longs (en temps et peut être aussi en longueur).
Je pense que comme les 2 états sont issus du même tableau, une simplification peut être apportée, mais là j'ai atteint mes limites.
Mon projet en PJ explication
J'ai un onglet "Base" dans cet onglet j'ai aussi un tableau intitulé "base"
Dans cet onglet lorsque je choisis un mois cellule C2 j'ai un code qui est généré.
1- le code va tout d'abord lancer une macro qui se trouve dans le module SUIVI
- Mise à blanc des états intermédiaires (FACTURE et FAE) qui servent à réaliser les TDC
- Section du tableau "Base" et copie sur l'état intermédiaire FAE
- Suppression des colonnes ne correspondant pas au mois sélectionné dans l'état FAE
- Suppression des lignes de cette colonne si j'ai la valeur vide ou ANNULEE
- Sélection de l'état intermédiaire FAE pour une copie dans l'état intermédiaire FACTURE : j'utilise cette étape intermédiaire car je n'aurais pas besoin dans mon état FAE de la colonne facture et dans mon état FACTURE de la colonne Programme
- Traitement de l'état FAE
- Suppression de toutes les valeurs différentes de FAE (à ce stade, je ne peux qu'avoir FAE, FACTURE ou ENCOURS)
- Tri par ordre croissant
- Traitement de l'état FACTURE
- Suppression de toutes les valeurs différentes de FACTURE (à ce stade, je ne peux qu'avoir FAE, FACTURE ou ENCOURS)
- Suppression des colonnes inutiles
- Tri par ordre croissant
- Protection de la feuille
2- Lancement du code MISE EN FORME ne concerne uniquement que la mise en forme de l'état des FAE avant d'obtenir le TDC final "ETAT DES FAE ATTENDU et enfin Actualisation de tous les TDC
En espérant avoir été clair et merci pour toute votre aide
Le fichier étant de 317 ko dépasse la limite du forum de 293 je ne sais pas comment vous le faire parvenir avec un exemple.
J'ai donc enregistré le fichier en xlsx et en le zippant
Si cela peut vous être utile voici le code
Module 1- Sub SUIVI_FAE()
Dim NB_COL, NB_LIG, COMPTEUR, LIGNE As Long
Dim MOIS_CHOISI As String
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
' remise à blanc des ancienne FAE
Sheets("FAE").Range("A1").CurrentRegion.Clear
Sheets("FACTURE").Range("A1").CurrentRegion.Clear
' Copie des nouvelles FAE
Sheets("Base").Select
MOIS_CHOISI = Range("c2").Value
' Déprotéger la feuille
ActiveSheet.Unprotect Password:="ProgSN"
Range("A4").CurrentRegion.Copy
Sheets("FAE").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
' Supprimer toutes les colonnes <> date choisi
NB_COL = Range("A1", Selection.End(xlToRight)).Count
For COMPTEUR = (NB_COL - 3) To 8 Step -1 'il faut partir en arrière
If Cells(1, COMPTEUR) <> MOIS_CHOISI Then
Columns(COMPTEUR).Delete
End If
Next COMPTEUR
NB_LIG = Range("A1", Selection.End(xlDown)).Count
For LIGNE = NB_LIG To 2 Step -1
If Cells(LIGNE, 8) = "" Or Cells(LIGNE, 8) = "ANNULEE" Then Rows(LIGNE).EntireRow.Delete
Next LIGNE
Range("A1").CurrentRegion.Copy
Sheets("FACTURE").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Sheets("FAE").Select
Columns("F:F").EntireColumn.Delete
'Supprimer toutes les lignes <> "FAE"
NB_LIG = Range("A1", Selection.End(xlDown)).Count
For LIGNE = NB_LIG To 2 Step -1
If Cells(LIGNE, 7).Value <> "FAE" Then
Rows(LIGNE).EntireRow.Delete
End If
Next LIGNE
Columns("G:G").EntireColumn.Delete
'Tri du tableau avant de faire le TDC
Range("A1").CurrentRegion.Sort Key1:=Range("C2"), Order1:=xlAscending, Key2:=Range("A2"), Order2:=xlAscending, Header:=True
Sheets("FACTURE").Select
NB_COL = Range("A1", Selection.End(xlToRight)).Count
'Supprimer toutes les lignes <> "FACTURE"
NB_LIG = Range("A1", Selection.End(xlDown)).Count
For LIGNE = NB_LIG To 2 Step -1
If Cells(LIGNE, 8).Value <> "FACTURE" Then
Rows(LIGNE).EntireRow.Delete
End If
Next LIGNE
Columns("H:k").EntireColumn.Delete
Columns("E:E").EntireColumn.Delete
'Tri du tableau avant de faire le TDC
Range("A1").CurrentRegion.Sort Key1:=Range("C2"), Order1:=xlAscending, Key2:=Range("A2"), Order2:=xlAscending, Header:=True
' Protéger la feuille
Sheets("Base").Protect Password:="ProgSN", AllowFiltering:=True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Sheets("Base").Select
End Sub
Module 2-
Sub Mise_En_Forme()
Dim I As Integer, DL As Integer, NbLigne As Integer, PlageTotalGen As String
Sheets("ETAT DES FAE ATTENDU").Select
' Envoyer dans la variable DL le nombre de ligne du tableau
DL = Range("A1").CurrentRegion.Rows.Count
' Effacer le tableau à droite du TCD
Range(Cells(2, 7), Cells(DL, 10)).Clear
' Actualiser le TCD
ActiveWorkbook.RefreshAll
' Envoyer dans la variable DL le nombre de ligne du tableau
DL = Range("A1").CurrentRegion.Rows.Count
' Définir une variable pour les formules de calcul
NbLigne = 0
PlageTotalGen = ""
For I = 2 To DL
' Ecrire la formule en colonne Solde
Cells(I, 9).FormulaR1C1 = "=RC[-3]-RC[-2]-RC[-1]"
' Tester le texte en colonne A et formater si le contenu commence par Total
If Left(Cells(I, 1), 5) = "Total" Then
' Ecrire les formules en colonnes Facturation et Correction
Cells(I, 7).FormulaR1C1 = "=SUM(R[-" & NbLigne & "]C:R[-1]C)"
Cells(I, 8).FormulaR1C1 = "=SUM(R[-" & NbLigne & "]C:R[-1]C)"
Cells(I, 9).FormulaR1C1 = "=SUM(R[-" & NbLigne & "]C:R[-1]C)"
' Définir les références de cellules pour le total général
PlageTotalGen = PlageTotalGen & "R" & I & "C,"
' Tracer les bordures
With Range(Cells(I, 1), Cells(I, 10)).Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Color = RGB(83, 143, 213)
.Weight = xlThin
End With
With Range(Cells(I, 1), Cells(I, 10)).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Color = RGB(83, 143, 213)
.Weight = xlThin
End With
' Mettre en caractères gras
Range(Cells(I, 5), Cells(I, 10)).Font.Bold = True
' Remettre le compteur de ligne pour les formules de calcul à zéro
NbLigne = 0
Else
Dernière édition:
