Simplification Macro
jp
-
eriiic Messages postés 24603 Date d'inscription Statut Contributeur Dernière intervention -
eriiic Messages postés 24603 Date d'inscription Statut Contributeur Dernière intervention -
Bonjour,
Je suis relativement débutant en VBA et ai développé le code ci-dessous. La macro fonctionne parfaitement. Je souhaiterais maintenant l'optimiser. Quelqu'un aurait-il la gentillesse de m'aider à le simplifier ?
Merci
jp
Sub MAJ_Commandes()
'
' Reporte commandes dans onglet Cons
'
Dim i As Integer
Dim j As Integer
Dim n As Integer
i = 4
j = 5
cnt = 0
Sheets("Cons").Range("A5:M300").Clear
Sheets("Cons").Range("A5:M300").NumberFormat = "#,##0"
Sheets("Cons").Range("I5:I300").Font.Italic = True
Sheets("Cons").Range("I5:I300").HorizontalAlignment = xlCenter
For n = 17 To 52
While Sheets("Commandes").Cells(i, 2) = 1
If Sheets("Commandes").Cells(i, 4) = Sheets("General").Cells(n, 3) Then
Sheets("Cons").Cells(j, 5) = Sheets("Commandes").Cells(i, 3)
Sheets("Flux").Cells(i, 3) = Sheets("Commandes").Cells(i, 3)
Sheets("Cons").Cells(j, 5).Value = Sheets("Commandes").Cells(i, 3)
Sheets("Cons").Cells(j, 6).Value = WorksheetFunction.VLookup(Cells(j, 5).Value, Sheets("Commandes").Range("C4:M300"), 2, False)
Sheets("Cons").Cells(j, 7).Value = WorksheetFunction.VLookup(Cells(j, 5).Value, Sheets("Commandes").Range("C4:M300"), 4, False)
Sheets("Cons").Cells(j, 8).Value = WorksheetFunction.VLookup(Cells(j, 5).Value, Sheets("Commandes").Range("C4:M300"), 5, False)
Sheets("Cons").Cells(j, 9).Value = WorksheetFunction.VLookup(Cells(j, 5).Value, Sheets("Commandes").Range("C4:M300"), 8, False)
Sheets("Cons").Cells(j, 11).Value = WorksheetFunction.VLookup(Cells(j, 5).Value, Sheets("Commandes").Range("C4:M300"), 9, False)
Sheets("Cons").Cells(j, 3).Value = WorksheetFunction.VLookup(Cells(j, 6).Value, Sheets("General").Range("C17:E55"), 3, False)
Sheets("Cons").Cells(j, 12).Value = WorksheetFunction.VLookup(Cells(j, 5).Value, Sheets("Flux").Range("C4:D300"), 2, False)
Sheets("Cons").Cells(j, 5).EntireRow.Select
Selection.Font.Color = RGB(73, 73, 73)
cnt = cnt + 1
Else
j = j - 1
End If
i = i + 1
j = j + 1
Wend
Sheets("Cons").Cells(4, 2) = cnt
i = 4
Next n
Call Format_Cons
Call Format2_Cons
Call Total_Cas_de_Base
Call Total_Budget
End Sub
Sub Format_Cons()
'
' Met en forme l'onglet Cons
'
Dim i As Integer
Dim derli As Long
i = 5
derli = Sheets("Cons").UsedRange.Row + Sheets("Cons").UsedRange.Rows.Count - 1
cnt = 0
For i = 5 To derli
If Not Sheets("Cons").Cells(i, 3) = Sheets("Cons").Cells(i + 1, 3) Then
Sheets("Cons").Cells(i + 1, 3).EntireRow.Insert shift:=xlDown
Sheets("Cons").Cells(i + 1, 3).EntireRow.Insert shift:=xlDown
Sheets("Cons").Cells(i + 1, 3).Value = WorksheetFunction.VLookup(Cells(i - 1, 3).Value, Sheets("General").Range("C9:F13"), 4, True)
Sheets("Cons").Cells(i + 1, 7).Value = "TOTAL"
Sheets("Cons").Cells(i + 1, 11).Value = WorksheetFunction.SumIf(Range("C5", "C300"), Cells(i, 3).Value, Range("K5", "K300"))
Sheets("Cons").Cells(i + 1, 12).Value = WorksheetFunction.SumIf(Range("C5", "C300"), Cells(i, 3).Value, Range("L5", "L300"))
Range(Sheets("Cons").Cells(i + 1, 3), Sheets("Cons").Cells(i + 1, 12)).Select
With Selection.Interior
.Pattern = xlGray25
.PatternThemeColor = xlThemeColorAccent3
.ColorIndex = xlAutomatic
.TintAndShade = 0
.PatternTintAndShade = 0.599963377788629
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ThemeColor = 7
.TintAndShade = -0.249946592608417
.Weight = xlThin
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ThemeColor = 7
.TintAndShade = -0.249946592608417
.Weight = xlThin
Selection.Font.Bold = True
i = i + 2
derli = derli + 2
cnt = cnt + 1
End With
End With
End With
End If
Sheets("Cons").Cells(5, 2) = cnt
Next i
End Sub
Sub Format2_Cons()
'
' Met en forme l'onglet Cons
'
Dim i As Integer
Dim derli As Long
i = 5
derli = Sheets("Cons").UsedRange.Row + Sheets("Cons").UsedRange.Rows.Count - 1
cnt = 0
For i = 5 To derli
If Not Sheets("Cons").Cells(i, 6) = Sheets("Cons").Cells(i + 1, 6) And Sheets("Cons").Cells(i, 6) <> "" Then
Sheets("Cons").Cells(i + 1, 6).EntireRow.Insert shift:=xlDown
Sheets("Cons").Cells(i + 1, 6).EntireRow.Insert shift:=xlDown
Sheets("Cons").Cells(i + 1, 4).Value = Sheets("Cons").Cells(i, 6).Value
Sheets("Cons").Cells(i + 1, 7).Value = "Sous-Total"
Sheets("Cons").Cells(i + 1, 10).Value = WorksheetFunction.VLookup(Cells(i + 1, 4).Value, Sheets("General").Range("C17:F55"), 4, False)
Sheets("Cons").Cells(i + 1, 11).Value = WorksheetFunction.SumIf(Range("F5", "F300"), Cells(i + 1, 4).Value, Range("K5", "K300"))
Sheets("Cons").Cells(i + 1, 12).Value = WorksheetFunction.SumIf(Range("F5", "F300"), Cells(i + 1, 4).Value, Range("L5", "L300"))
Range(Sheets("Cons").Cells(i + 1, 4), Sheets("Cons").Cells(i + 1, 12)).Select
Selection.Interior.ColorIndex = xlColorIndexNone
Selection.Font.Color = RGB(70, 130, 180)
Selection.Font.Bold = True
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ThemeColor = 2
.TintAndShade = -0.249946592608417
.Weight = xlThin
i = i + 2
derli = derli + 2
cnt = cnt + 1
End With
End If
Sheets("Cons").Cells(6, 2) = cnt
Next i
End Sub
Sub Total_Budget()
'
'Totalise les coûts
'
Dim i As Integer
i = 3 + Sheets("Cons").Cells(4, 2).Value + Sheets("Cons").Cells(5, 2).Value * 2 + Sheets("Cons").Cells(6, 2).Value * 2
Sheets("Cons").Cells(i + 2, 7).Value = "TOTAL BUDGET"
Sheets("Cons").Cells(i + 2, 10).Value = WorksheetFunction.SumIf(Range("G5", "G300"), "TOTAL", Range("J5", "J300"))
Sheets("Cons").Cells(i + 2, 11).Value = WorksheetFunction.SumIf(Range("G5", "G300"), "TOTAL", Range("K5", "K300"))
Sheets("Cons").Cells(i + 2, 12).Value = WorksheetFunction.SumIf(Range("G5", "G300"), "TOTAL", Range("L5", "L300"))
Range(Sheets("Cons").Cells(i + 2, 7), Sheets("Cons").Cells(i + 2, 12)).Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ThemeColor = 2
.TintAndShade = 0.249946592608417
.Weight = xlMedium
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ThemeColor = 2
.TintAndShade = 0.249946592608417
.Weight = xlMedium
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ThemeColor = 2
.TintAndShade = 0.249946592608417
.Weight = xlMedium
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ThemeColor = 2
.TintAndShade = 0.249946592608417
.Weight = xlMedium
Selection.Font.Bold = True
Selection.Font.Color = RGB(73, 73, 73)
End With
End With
End With
End With
End Sub
Sub Total_Cas_de_Base()
'
'Totalise le Cas de Base
'
Dim i As Integer
Dim derli As Long
i = 5
derli = Sheets("Cons").UsedRange.Row + Sheets("Cons").UsedRange.Rows.Count - 1
For i = 5 To derli
If Sheets("Cons").Cells(i, 7).Value = "Sous-Total" Then
Sheets("Cons").Cells(i, 3).Value = Sheets("Cons").Cells(i - 1, 3).Value
Else
If Sheets("Cons").Cells(i, 7).Value = "TOTAL" Then
Sheets("Cons").Cells(i, 10).Value = WorksheetFunction.SumIf(Range("C5", "C300"), Cells(i - 2, 3).Value, Range("J5", "J300"))
i = i + 1
derli = derli + 1
End If
End If
Next i
End Sub
Je suis relativement débutant en VBA et ai développé le code ci-dessous. La macro fonctionne parfaitement. Je souhaiterais maintenant l'optimiser. Quelqu'un aurait-il la gentillesse de m'aider à le simplifier ?
Merci
jp
Sub MAJ_Commandes()
'
' Reporte commandes dans onglet Cons
'
Dim i As Integer
Dim j As Integer
Dim n As Integer
i = 4
j = 5
cnt = 0
Sheets("Cons").Range("A5:M300").Clear
Sheets("Cons").Range("A5:M300").NumberFormat = "#,##0"
Sheets("Cons").Range("I5:I300").Font.Italic = True
Sheets("Cons").Range("I5:I300").HorizontalAlignment = xlCenter
For n = 17 To 52
While Sheets("Commandes").Cells(i, 2) = 1
If Sheets("Commandes").Cells(i, 4) = Sheets("General").Cells(n, 3) Then
Sheets("Cons").Cells(j, 5) = Sheets("Commandes").Cells(i, 3)
Sheets("Flux").Cells(i, 3) = Sheets("Commandes").Cells(i, 3)
Sheets("Cons").Cells(j, 5).Value = Sheets("Commandes").Cells(i, 3)
Sheets("Cons").Cells(j, 6).Value = WorksheetFunction.VLookup(Cells(j, 5).Value, Sheets("Commandes").Range("C4:M300"), 2, False)
Sheets("Cons").Cells(j, 7).Value = WorksheetFunction.VLookup(Cells(j, 5).Value, Sheets("Commandes").Range("C4:M300"), 4, False)
Sheets("Cons").Cells(j, 8).Value = WorksheetFunction.VLookup(Cells(j, 5).Value, Sheets("Commandes").Range("C4:M300"), 5, False)
Sheets("Cons").Cells(j, 9).Value = WorksheetFunction.VLookup(Cells(j, 5).Value, Sheets("Commandes").Range("C4:M300"), 8, False)
Sheets("Cons").Cells(j, 11).Value = WorksheetFunction.VLookup(Cells(j, 5).Value, Sheets("Commandes").Range("C4:M300"), 9, False)
Sheets("Cons").Cells(j, 3).Value = WorksheetFunction.VLookup(Cells(j, 6).Value, Sheets("General").Range("C17:E55"), 3, False)
Sheets("Cons").Cells(j, 12).Value = WorksheetFunction.VLookup(Cells(j, 5).Value, Sheets("Flux").Range("C4:D300"), 2, False)
Sheets("Cons").Cells(j, 5).EntireRow.Select
Selection.Font.Color = RGB(73, 73, 73)
cnt = cnt + 1
Else
j = j - 1
End If
i = i + 1
j = j + 1
Wend
Sheets("Cons").Cells(4, 2) = cnt
i = 4
Next n
Call Format_Cons
Call Format2_Cons
Call Total_Cas_de_Base
Call Total_Budget
End Sub
Sub Format_Cons()
'
' Met en forme l'onglet Cons
'
Dim i As Integer
Dim derli As Long
i = 5
derli = Sheets("Cons").UsedRange.Row + Sheets("Cons").UsedRange.Rows.Count - 1
cnt = 0
For i = 5 To derli
If Not Sheets("Cons").Cells(i, 3) = Sheets("Cons").Cells(i + 1, 3) Then
Sheets("Cons").Cells(i + 1, 3).EntireRow.Insert shift:=xlDown
Sheets("Cons").Cells(i + 1, 3).EntireRow.Insert shift:=xlDown
Sheets("Cons").Cells(i + 1, 3).Value = WorksheetFunction.VLookup(Cells(i - 1, 3).Value, Sheets("General").Range("C9:F13"), 4, True)
Sheets("Cons").Cells(i + 1, 7).Value = "TOTAL"
Sheets("Cons").Cells(i + 1, 11).Value = WorksheetFunction.SumIf(Range("C5", "C300"), Cells(i, 3).Value, Range("K5", "K300"))
Sheets("Cons").Cells(i + 1, 12).Value = WorksheetFunction.SumIf(Range("C5", "C300"), Cells(i, 3).Value, Range("L5", "L300"))
Range(Sheets("Cons").Cells(i + 1, 3), Sheets("Cons").Cells(i + 1, 12)).Select
With Selection.Interior
.Pattern = xlGray25
.PatternThemeColor = xlThemeColorAccent3
.ColorIndex = xlAutomatic
.TintAndShade = 0
.PatternTintAndShade = 0.599963377788629
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ThemeColor = 7
.TintAndShade = -0.249946592608417
.Weight = xlThin
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ThemeColor = 7
.TintAndShade = -0.249946592608417
.Weight = xlThin
Selection.Font.Bold = True
i = i + 2
derli = derli + 2
cnt = cnt + 1
End With
End With
End With
End If
Sheets("Cons").Cells(5, 2) = cnt
Next i
End Sub
Sub Format2_Cons()
'
' Met en forme l'onglet Cons
'
Dim i As Integer
Dim derli As Long
i = 5
derli = Sheets("Cons").UsedRange.Row + Sheets("Cons").UsedRange.Rows.Count - 1
cnt = 0
For i = 5 To derli
If Not Sheets("Cons").Cells(i, 6) = Sheets("Cons").Cells(i + 1, 6) And Sheets("Cons").Cells(i, 6) <> "" Then
Sheets("Cons").Cells(i + 1, 6).EntireRow.Insert shift:=xlDown
Sheets("Cons").Cells(i + 1, 6).EntireRow.Insert shift:=xlDown
Sheets("Cons").Cells(i + 1, 4).Value = Sheets("Cons").Cells(i, 6).Value
Sheets("Cons").Cells(i + 1, 7).Value = "Sous-Total"
Sheets("Cons").Cells(i + 1, 10).Value = WorksheetFunction.VLookup(Cells(i + 1, 4).Value, Sheets("General").Range("C17:F55"), 4, False)
Sheets("Cons").Cells(i + 1, 11).Value = WorksheetFunction.SumIf(Range("F5", "F300"), Cells(i + 1, 4).Value, Range("K5", "K300"))
Sheets("Cons").Cells(i + 1, 12).Value = WorksheetFunction.SumIf(Range("F5", "F300"), Cells(i + 1, 4).Value, Range("L5", "L300"))
Range(Sheets("Cons").Cells(i + 1, 4), Sheets("Cons").Cells(i + 1, 12)).Select
Selection.Interior.ColorIndex = xlColorIndexNone
Selection.Font.Color = RGB(70, 130, 180)
Selection.Font.Bold = True
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ThemeColor = 2
.TintAndShade = -0.249946592608417
.Weight = xlThin
i = i + 2
derli = derli + 2
cnt = cnt + 1
End With
End If
Sheets("Cons").Cells(6, 2) = cnt
Next i
End Sub
Sub Total_Budget()
'
'Totalise les coûts
'
Dim i As Integer
i = 3 + Sheets("Cons").Cells(4, 2).Value + Sheets("Cons").Cells(5, 2).Value * 2 + Sheets("Cons").Cells(6, 2).Value * 2
Sheets("Cons").Cells(i + 2, 7).Value = "TOTAL BUDGET"
Sheets("Cons").Cells(i + 2, 10).Value = WorksheetFunction.SumIf(Range("G5", "G300"), "TOTAL", Range("J5", "J300"))
Sheets("Cons").Cells(i + 2, 11).Value = WorksheetFunction.SumIf(Range("G5", "G300"), "TOTAL", Range("K5", "K300"))
Sheets("Cons").Cells(i + 2, 12).Value = WorksheetFunction.SumIf(Range("G5", "G300"), "TOTAL", Range("L5", "L300"))
Range(Sheets("Cons").Cells(i + 2, 7), Sheets("Cons").Cells(i + 2, 12)).Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ThemeColor = 2
.TintAndShade = 0.249946592608417
.Weight = xlMedium
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ThemeColor = 2
.TintAndShade = 0.249946592608417
.Weight = xlMedium
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ThemeColor = 2
.TintAndShade = 0.249946592608417
.Weight = xlMedium
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ThemeColor = 2
.TintAndShade = 0.249946592608417
.Weight = xlMedium
Selection.Font.Bold = True
Selection.Font.Color = RGB(73, 73, 73)
End With
End With
End With
End With
End Sub
Sub Total_Cas_de_Base()
'
'Totalise le Cas de Base
'
Dim i As Integer
Dim derli As Long
i = 5
derli = Sheets("Cons").UsedRange.Row + Sheets("Cons").UsedRange.Rows.Count - 1
For i = 5 To derli
If Sheets("Cons").Cells(i, 7).Value = "Sous-Total" Then
Sheets("Cons").Cells(i, 3).Value = Sheets("Cons").Cells(i - 1, 3).Value
Else
If Sheets("Cons").Cells(i, 7).Value = "TOTAL" Then
Sheets("Cons").Cells(i, 10).Value = WorksheetFunction.SumIf(Range("C5", "C300"), Cells(i - 2, 3).Value, Range("J5", "J300"))
i = i + 1
derli = derli + 1
End If
End If
Next i
End Sub
A voir également:
- Simplification Macro
- Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur
- Jitbit macro recorder - Télécharger - Confidentialité
- Télécharger macro convertir chiffre en lettre excel - Télécharger - Tableur
- Macro maker - Télécharger - Divers Utilitaires
- Macro word - Guide
2 réponses
Bonjour
Une chose peut-être à modifier, remplacez les 2 lignes suivantes
par
bonne journée
cdlt
Une chose peut-être à modifier, remplacez les 2 lignes suivantes
Sheets("Cons").Cells(i + 1, 6).EntireRow.Insert shift:=xlDown Sheets("Cons").Cells(i + 1, 6).EntireRow.Insert shift:=xlDown
par
Sheets("Feuil1").Range(Cells(i + 1, 1), Cells(i + 2, 1)).EntireRow.Insert shift:=xlDowninutile de répéter plusieurs fois la même action, pour le reste, je ne pense pas que l'on puisse faire mieux. c'est déjà bien optimisé.
bonne journée
cdlt
Bonsoir,
tu pourrais ajouter en début de macro :
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
et en fin:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Calculate
Si tu as de formules qui peuvent évoluer selon ta macro, et que tu doives réutiliser le résultat dans la macro penser à mettre un Calculate avant.
eric
tu pourrais ajouter en début de macro :
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
et en fin:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Calculate
Si tu as de formules qui peuvent évoluer selon ta macro, et que tu doives réutiliser le résultat dans la macro penser à mettre un Calculate avant.
eric