Simplification Macro
jp
-
eriiic Messages postés 24581 Date d'inscription Statut Contributeur Dernière intervention -
eriiic Messages postés 24581 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
2 réponses
-
Bonjour
Une chose peut-être à modifier, remplacez les 2 lignes suivantesSheets("Cons").Cells(i + 1, 6).EntireRow.Insert shift:=xlDown Sheets("Cons").Cells(i + 1, 6).EntireRow.Insert shift:=xlDown
parSheets("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