Simplification Macro

Fermé
jp - 23 août 2013 à 17:14
eriiic Messages postés 24601 Date d'inscription mardi 11 septembre 2007 Statut Contributeur Dernière intervention 25 novembre 2024 - 29 août 2013 à 00:07
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


A voir également:

2 réponses

Frenchie83 Messages postés 2240 Date d'inscription lundi 6 mai 2013 Statut Membre Dernière intervention 11 août 2023 338
25 août 2013 à 08:04
Bonjour
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:=xlDown
inutile 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
0
eriiic Messages postés 24601 Date d'inscription mardi 11 septembre 2007 Statut Contributeur Dernière intervention 25 novembre 2024 7 243
29 août 2013 à 00:07
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
0