Macro Excel 2016 + lente que dans Excel 2007
Bonjour à tous,
Je vous explique mon problème. J'ai une macro qui tourne en moins d'une minute sous Excel 2007 et qui met 40 minutes sous Excel 2017. Je précise que je n'ai pas fait la macro moi même.
Pouvez m'aider à l'optimiser afin d'obtenir le même temps de traitement que sous Excel 2007 (ou approchant) SVP ?
Attention, la macro est surement difficile à lire car non structurée ! Bon courage et merci d'avance
Ci dessous la macro :
'File
Dim SIMFILE As String 'Name of the SIM File
Dim EXTRACTFILE As String 'Name of the Extract file
'Sheet
Dim SIMSHEET As String 'Name of the SIM's sheet
Dim EXTRACTSHEET As String 'Name of the extract's sheet
Dim MODIFICATIONSHEET As String ' Name of the modification sheet
Dim SUPPRESSIONSHEET As String 'Name of the deleted row sheet
'Index
Dim MODIFICATION As Integer 'Index of the last modification in the sheet "Modifications"
Dim SUPPRIMEE As Integer 'Index of the last suppression in the sheet "Deleted rows"
'MPM
Dim MPM As String
Function InsertionSub(EXTRACT As Integer, SIM As Integer)
'Creation of the new line
Workbooks(SIMFILE).Worksheets(SIMSHEET).Select
Workbooks(SIMFILE).Worksheets(SIMSHEET).Rows(SIM & ":" & SIM).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
If SIM = 4 Then
Workbooks(SIMFILE).Worksheets(SIMSHEET).Rows(SIM + 1 & ":" & SIM + 1).Select
Selection.Copy
Workbooks(SIMFILE).Worksheets(SIMSHEET).Rows(SIM & ":" & SIM).Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End If
Workbooks(EXTRACTFILE).Sheets(EXTRACTSHEET).Activate
Workbooks(EXTRACTFILE).Sheets(EXTRACTSHEET).Range(Workbooks(EXTRACTFILE).Sheets(EXTRACTSHEET).Cells(EXTRACT, 1).address(RowAbsolute:=False, ColumnAbsolute:=False) & ":" & Workbooks(EXTRACTFILE).Sheets(EXTRACTSHEET).Cells(EXTRACT, 51).address(RowAbsolute:=False, ColumnAbsolute:=False)).Select
Selection.Copy
Workbooks(SIMFILE).Sheets(SIMSHEET).Activate
Workbooks(SIMFILE).Sheets(SIMSHEET).Cells(SIM, 2).Select
'ActiveSheet.Paste
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Workbooks(SIMFILE).Sheets(SIMSHEET).Cells(SIM, 1).Value = 0
'Update de l'onglet modifications
Workbooks(SIMFILE).Sheets(MODIFICATIONSHEET).Cells(MODIFICATION, 1).Value = "Ajout"
Workbooks(SIMFILE).Sheets(MODIFICATIONSHEET).Cells(MODIFICATION, 2).Value = Workbooks(SIMFILE).Sheets(SIMSHEET).Cells(SIM, 2).Value
Workbooks(SIMFILE).Sheets(MODIFICATIONSHEET).Cells(MODIFICATION, 3).Value = Workbooks(SIMFILE).Sheets(SIMSHEET).Cells(SIM, 7).Value
Workbooks(SIMFILE).Sheets(MODIFICATIONSHEET).Cells(MODIFICATION, 4).Value = Workbooks(SIMFILE).Sheets(SIMSHEET).Cells(SIM, 4).Value
Workbooks(SIMFILE).Sheets(MODIFICATIONSHEET).Cells(MODIFICATION, 5).Value = Workbooks(SIMFILE).Sheets(SIMSHEET).Cells(SIM, 48).Value
Workbooks(SIMFILE).Sheets(MODIFICATIONSHEET).Cells(MODIFICATION, 6).Value = Workbooks(SIMFILE).Sheets(SIMSHEET).Cells(SIM, 29).Value
Workbooks(SIMFILE).Sheets(MODIFICATIONSHEET).Cells(MODIFICATION, 7).Value = Workbooks(SIMFILE).Sheets(SIMSHEET).Cells(SIM, 34).Value
Workbooks(SIMFILE).Sheets(MODIFICATIONSHEET).Cells(MODIFICATION, 8).Value = Workbooks(SIMFILE).Sheets(SIMSHEET).Cells(SIM, 51).Value
Workbooks(SIMFILE).Sheets(MODIFICATIONSHEET).Cells(MODIFICATION, 9).Value = Workbooks(SIMFILE).Sheets(SIMSHEET).Cells(SIM, 19).Value
Workbooks(SIMFILE).Sheets(MODIFICATIONSHEET).Cells(MODIFICATION, 34).Value = 0
Workbooks(SIMFILE).Sheets(MODIFICATIONSHEET).Select
Range("AI" & MODIFICATION).Select
ActiveCell.FormulaR1C1 = _
"=SUM(VLOOKUP(RC2,INDIRECT(R1C30&R1C31),{66;67},FALSE))"
Range("AJ" & MODIFICATION).Select
ActiveCell.FormulaR1C1 = "=RC[-1]-RC[-2]"
MODIFICATION = MODIFICATION + 1
End Function
Sub SuppressionSub(SIM As Integer)
'Suppression of the old line
Workbooks(SIMFILE).Sheets(MODIFICATIONSHEET).Cells(MODIFICATION, 1).Value = "Suppression"
Workbooks(SIMFILE).Sheets(MODIFICATIONSHEET).Cells(MODIFICATION, 2).Value = Workbooks(SIMFILE).Sheets(SIMSHEET).Cells(SIM, 2).Value
Workbooks(SIMFILE).Sheets(MODIFICATIONSHEET).Cells(MODIFICATION, 3).Value = Workbooks(SIMFILE).Sheets(SIMSHEET).Cells(SIM, 7).Value
Workbooks(SIMFILE).Sheets(MODIFICATIONSHEET).Cells(MODIFICATION, 4).Value = Workbooks(SIMFILE).Sheets(SIMSHEET).Cells(SIM, 4).Value
Workbooks(SIMFILE).Sheets(MODIFICATIONSHEET).Cells(MODIFICATION, 5).Value = Workbooks(SIMFILE).Sheets(SIMSHEET).Cells(SIM, 48).Value
Workbooks(SIMFILE).Sheets(MODIFICATIONSHEET).Cells(MODIFICATION, 6).Value = Workbooks(SIMFILE).Sheets(SIMSHEET).Cells(SIM, 29).Value
Workbooks(SIMFILE).Sheets(MODIFICATIONSHEET).Cells(MODIFICATION, 7).Value = Workbooks(SIMFILE).Sheets(SIMSHEET).Cells(SIM, 34).Value
Workbooks(SIMFILE).Sheets(MODIFICATIONSHEET).Cells(MODIFICATION, 8).Value = Workbooks(SIMFILE).Sheets(SIMSHEET).Cells(SIM, 51).Value
Workbooks(SIMFILE).Sheets(MODIFICATIONSHEET).Cells(MODIFICATION, 9).Value = Workbooks(SIMFILE).Sheets(SIMSHEET).Cells(SIM, 19).Value
Workbooks(SIMFILE).Sheets(MODIFICATIONSHEET).Cells(MODIFICATION, 34).Value = Workbooks(SIMFILE).Sheets(SIMSHEET).Cells(SIM, 67).Value + Workbooks(SIMFILE).Sheets(SIMSHEET).Cells(SIM, 68).Value
Workbooks(SIMFILE).Sheets(MODIFICATIONSHEET).Select
Range("AI" & MODIFICATION).Value = 0
Range("AJ" & MODIFICATION).Select
ActiveCell.FormulaR1C1 = "=RC[-1]-RC[-2]"
MODIFICATION = MODIFICATION + 1
Workbooks(SIMFILE).Worksheets(SIMSHEET).Select
Workbooks(SIMFILE).Worksheets(SIMSHEET).Rows(SIM & ":" & SIM).Select
Selection.Copy
Workbooks(SIMFILE).Sheets(SUPPRESSIONSHEET).Select
Rows(SUPPRIMEE & ":" & SUPPRIMEE).Select
ActiveSheet.Paste
Range("A" & SUPPRIMEE).Select
ActiveCell.FormulaR1C1 = "=TODAY()"
Range("A" & SUPPRIMEE).Select
Selection.Copy
Range("A" & SUPPRIMEE).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
SUPPRIMEE = SUPPRIMEE + 1
Workbooks(SIMFILE).Worksheets(SIMSHEET).Activate
Workbooks(SIMFILE).Worksheets(SIMSHEET).Rows(SIM & ":" & SIM).Select
Selection.Delete Shift:=xlUp
End Sub
Function ModficationSub(EXTRACT As Integer, SIM As Integer)
'Search changes
Dim Changes As String
Changes = ""
'TODO Check and update modification SHEET
If Workbooks(EXTRACTFILE).Sheets(EXTRACTSHEET).Cells(EXTRACT, 6).Value <> Workbooks(SIMFILE).Sheets(SIMSHEET).Cells(SIM, 7).Value Then
Changes = Changes & "LEVER" & Chr(10)
'Avant
Workbooks(SIMFILE).Sheets(MODIFICATIONSHEET).Cells(MODIFICATION, 20).Value = Workbooks(SIMFILE).Sheets(SIMSHEET).Cells(SIM, 7).Value
'Après
Workbooks(SIMFILE).Sheets(MODIFICATIONSHEET).Cells(MODIFICATION, 32).Value = Workbooks(EXTRACTFILE).Sheets(EXTRACTSHEET).Cells(EXTRACT, 6).Value
End If
'
If Workbooks(EXTRACTFILE).Sheets(EXTRACTSHEET).Cells(EXTRACT, 43).Value <> Workbooks(SIMFILE).Sheets(SIMSHEET).Cells(SIM, 44).Value Then
Changes = Changes & "Delta in volume" & Chr(10)
'Avant
Workbooks(SIMFILE).Sheets(MODIFICATIONSHEET).Cells(MODIFICATION, 21).Value = Workbooks(SIMFILE).Sheets(SIMSHEET).Cells(SIM, 44).Value
'Après
Workbooks(SIMFILE).Sheets(MODIFICATIONSHEET).Cells(MODIFICATION, 33).Value = Workbooks(EXTRACTFILE).Sheets(EXTRACTSHEET).Cells(EXTRACT, 43).Value
End If
'
If Workbooks(EXTRACTFILE).Sheets(EXTRACTSHEET).Cells(EXTRACT, 5).Value <> Workbooks(SIMFILE).Sheets(SIMSHEET).Cells(SIM, 6).Value Then
Changes = Changes & "TEMPO ID" & Chr(10)
'Avant
Workbooks(SIMFILE).Sheets(MODIFICATIONSHEET).Cells(MODIFICATION, 10).Value = Workbooks(SIMFILE).Sheets(SIMSHEET).Cells(SIM, 6).Value
'Après
Workbooks(SIMFILE).Sheets(MODIFICATIONSHEET).Cells(MODIFICATION, 22).Value = Workbooks(EXTRACTFILE).Sheets(EXTRACTSHEET).Cells(EXTRACT, 5).Value
End If
If Workbooks(EXTRACTFILE).Sheets(EXTRACTSHEET).Cells(EXTRACT, 8).Value <> Workbooks(SIMFILE).Sheets(SIMSHEET).Cells(SIM, 9).Value Then
Changes = Changes & "PHASE" & Chr(10)
'Avant
Workbooks(SIMFILE).Sheets(MODIFICATIONSHEET).Cells(MODIFICATION, 11).Value = Workbooks(SIMFILE).Sheets(SIMSHEET).Cells(SIM, 9).Value
'Après
Workbooks(SIMFILE).Sheets(MODIFICATIONSHEET).Cells(MODIFICATION, 23).Value = Workbooks(EXTRACTFILE).Sheets(EXTRACTSHEET).Cells(EXTRACT, 8).Value
End If
If Workbooks(EXTRACTFILE).Sheets(EXTRACTSHEET).Cells(EXTRACT, 12).Value <> Workbooks(SIMFILE).Sheets(SIMSHEET).Cells(SIM, 13).Value Then
Changes = Changes & "Main Program" & Chr(10)
'Avant
Workbooks(SIMFILE).Sheets(MODIFICATIONSHEET).Cells(MODIFICATION, 12).Value = Workbooks(SIMFILE).Sheets(SIMSHEET).Cells(SIM, 13).Value
'Après
Workbooks(SIMFILE).Sheets(MODIFICATIONSHEET).Cells(MODIFICATION, 24).Value = Workbooks(EXTRACTFILE).Sheets(EXTRACTSHEET).Cells(EXTRACT, 12).Value
End If
If Workbooks(EXTRACTFILE).Sheets(EXTRACTSHEET).Cells(EXTRACT, 14).Value <> Workbooks(SIMFILE).Sheets(SIMSHEET).Cells(SIM, 15).Value Then
Changes = Changes & "Product Line" & Chr(10)
'Avant
Workbooks(SIMFILE).Sheets(MODIFICATIONSHEET).Cells(MODIFICATION, 13).Value = Workbooks(SIMFILE).Sheets(SIMSHEET).Cells(SIM, 15).Value
'Après
Workbooks(SIMFILE).Sheets(MODIFICATIONSHEET).Cells(MODIFICATION, 25).Value = Workbooks(EXTRACTFILE).Sheets(EXTRACTSHEET).Cells(EXTRACT, 14).Value
End If
If Workbooks(EXTRACTFILE).Sheets(EXTRACTSHEET).Cells(EXTRACT, 25).Value <> Workbooks(SIMFILE).Sheets(SIMSHEET).Cells(SIM, 26).Value Then
Changes = Changes & "End date" & Chr(10)
'Avant
Workbooks(SIMFILE).Sheets(MODIFICATIONSHEET).Cells(MODIFICATION, 14).Value = Workbooks(SIMFILE).Sheets(SIMSHEET).Cells(SIM, 26).Value
'Après
Workbooks(SIMFILE).Sheets(MODIFICATIONSHEET).Cells(MODIFICATION, 26).Value = Workbooks(EXTRACTFILE).Sheets(EXTRACTSHEET).Cells(EXTRACT, 25).Value
End If
If Workbooks(EXTRACTFILE).Sheets(EXTRACTSHEET).Cells(EXTRACT, 36).Value <> Workbooks(SIMFILE).Sheets(SIMSHEET).Cells(SIM, 37).Value Then
Changes = Changes & "Manuf Country" & Chr(10)
'Avant
Workbooks(SIMFILE).Sheets(MODIFICATIONSHEET).Cells(MODIFICATION, 15).Value = Workbooks(SIMFILE).Sheets(SIMSHEET).Cells(SIM, 37).Value
'Après
Workbooks(SIMFILE).Sheets(MODIFICATIONSHEET).Cells(MODIFICATION, 27).Value = Workbooks(EXTRACTFILE).Sheets(EXTRACTSHEET).Cells(EXTRACT, 36).Value
End If
If Workbooks(EXTRACTFILE).Sheets(EXTRACTSHEET).Cells(EXTRACT, 37).Value <> Workbooks(SIMFILE).Sheets(SIMSHEET).Cells(SIM, 38).Value Then
Changes = Changes & "P&L date" & Chr(10)
'Avant
Workbooks(SIMFILE).Sheets(MODIFICATIONSHEET).Cells(MODIFICATION, 16).Value = Workbooks(SIMFILE).Sheets(SIMSHEET).Cells(SIM, 38).Value
'Après
Workbooks(SIMFILE).Sheets(MODIFICATIONSHEET).Cells(MODIFICATION, 28).Value = Workbooks(EXTRACTFILE).Sheets(EXTRACTSHEET).Cells(EXTRACT, 37).Value
End If
If Workbooks(EXTRACTFILE).Sheets(EXTRACTSHEET).Cells(EXTRACT, 38).Value <> Workbooks(SIMFILE).Sheets(SIMSHEET).Cells(SIM, 39).Value Then
Changes = Changes & "Initial spend" & Chr(10)
'Avant
Workbooks(SIMFILE).Sheets(MODIFICATIONSHEET).Cells(MODIFICATION, 17).Value = Workbooks(SIMFILE).Sheets(SIMSHEET).Cells(SIM, 39).Value
'Après
Workbooks(SIMFILE).Sheets(MODIFICATIONSHEET).Cells(MODIFICATION, 29).Value = Workbooks(EXTRACTFILE).Sheets(EXTRACTSHEET).Cells(EXTRACT, 38).Value
End If
If Workbooks(EXTRACTFILE).Sheets(EXTRACTSHEET).Cells(EXTRACT, 39).Value <> Workbooks(SIMFILE).Sheets(SIMSHEET).Cells(SIM, 40).Value Then
Changes = Changes & "FYS" & Chr(10)
'Avant
Workbooks(SIMFILE).Sheets(MODIFICATIONSHEET).Cells(MODIFICATION, 18).Value = Workbooks(SIMFILE).Sheets(SIMSHEET).Cells(SIM, 40).Value
'Après
Workbooks(SIMFILE).Sheets(MODIFICATIONSHEET).Cells(MODIFICATION, 30).Value = Workbooks(EXTRACTFILE).Sheets(EXTRACTSHEET).Cells(EXTRACT, 39).Value
End If
If Workbooks(EXTRACTFILE).Sheets(EXTRACTSHEET).Cells(EXTRACT, 41).Value <> Workbooks(SIMFILE).Sheets(SIMSHEET).Cells(SIM, 42).Value Then
Changes = Changes & "CF" & Chr(10)
'Avant
Workbooks(SIMFILE).Sheets(MODIFICATIONSHEET).Cells(MODIFICATION, 19).Value = Workbooks(SIMFILE).Sheets(SIMSHEET).Cells(SIM, 42).Value
'Après
Workbooks(SIMFILE).Sheets(MODIFICATIONSHEET).Cells(MODIFICATION, 31).Value = Workbooks(EXTRACTFILE).Sheets(EXTRACTSHEET).Cells(EXTRACT, 41).Value
End If
If Changes <> "" Then
'Modification de l'Format, changement du statut
Workbooks(SIMFILE).Sheets(SIMSHEET).Cells(SIM, 1).Value = 2
'Ajout d'une ligne dans le tableau des modifications
Workbooks(SIMFILE).Sheets(MODIFICATIONSHEET).Cells(MODIFICATION, 1).Value = "Modification"
Workbooks(SIMFILE).Sheets(MODIFICATIONSHEET).Cells(MODIFICATION, 2).Value = Workbooks(SIMFILE).Sheets(SIMSHEET).Cells(SIM, 2).Value
Workbooks(SIMFILE).Sheets(MODIFICATIONSHEET).Cells(MODIFICATION, 3).Value = Workbooks(SIMFILE).Sheets(SIMSHEET).Cells(SIM, 7).Value
Workbooks(SIMFILE).Sheets(MODIFICATIONSHEET).Cells(MODIFICATION, 4).Value = Workbooks(SIMFILE).Sheets(SIMSHEET).Cells(SIM, 4).Value
Workbooks(SIMFILE).Sheets(MODIFICATIONSHEET).Cells(MODIFICATION, 5).Value = Workbooks(SIMFILE).Sheets(SIMSHEET).Cells(SIM, 48).Value
Workbooks(SIMFILE).Sheets(MODIFICATIONSHEET).Cells(MODIFICATION, 6).Value = Workbooks(SIMFILE).Sheets(SIMSHEET).Cells(SIM, 29).Value
Workbooks(SIMFILE).Sheets(MODIFICATIONSHEET).Cells(MODIFICATION, 7).Value = Workbooks(SIMFILE).Sheets(SIMSHEET).Cells(SIM, 34).Value
Workbooks(SIMFILE).Sheets(MODIFICATIONSHEET).Cells(MODIFICATION, 8).Value = Workbooks(SIMFILE).Sheets(SIMSHEET).Cells(SIM, 51).Value
Workbooks(SIMFILE).Sheets(MODIFICATIONSHEET).Cells(MODIFICATION, 9).Value = Workbooks(SIMFILE).Sheets(SIMSHEET).Cells(SIM, 19).Value
Workbooks(SIMFILE).Sheets(MODIFICATIONSHEET).Cells(MODIFICATION, 34).Value = Workbooks(SIMFILE).Sheets(SIMSHEET).Cells(SIM, 67).Value + Workbooks(SIMFILE).Sheets(SIMSHEET).Cells(SIM, 68).Value
Workbooks(SIMFILE).Sheets(MODIFICATIONSHEET).Select
Range("AI" & MODIFICATION).Select
ActiveCell.FormulaR1C1 = _
"=SUM(VLOOKUP(RC2,INDIRECT(R1C30&R1C31),{66;67},FALSE))"
Range("AJ" & MODIFICATION).Select
ActiveCell.FormulaR1C1 = "=RC[-1]-RC[-2]"
MODIFICATION = MODIFICATION + 1
Else
Workbooks(SIMFILE).Sheets(SIMSHEET).Cells(SIM, 1).Value = 1
End If
'Copy the new line
Workbooks(EXTRACTFILE).Sheets(EXTRACTSHEET).Activate
Workbooks(EXTRACTFILE).Sheets(EXTRACTSHEET).Range(Workbooks(EXTRACTFILE).Sheets(EXTRACTSHEET).Cells(EXTRACT, 1).address(RowAbsolute:=False, ColumnAbsolute:=False) & ":" & Workbooks(EXTRACTFILE).Sheets(EXTRACTSHEET).Cells(EXTRACT, 51).address(RowAbsolute:=False, ColumnAbsolute:=False)).Select
Selection.Copy
Workbooks(SIMFILE).Sheets(SIMSHEET).Activate
Workbooks(SIMFILE).Sheets(SIMSHEET).Cells(SIM, 2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End Function
Function OpenExtract(partialName As String) As String
Application.DisplayAlerts = False 'retire les alertes Excel si le fichier est déjà ouvert
If Dir(ActiveWorkbook.Path & "\" & partialName) <> "" Then 'Vérification de l'existance du fichier extract
Workbooks.Open (ActiveWorkbook.Path & "\" & Dir(ActiveWorkbook.Path & "\" & partialName))
Workbooks(Dir(ActiveWorkbook.Path & "\" & partialName)).Activate
Application.DisplayAlerts = True
Else
MsgBox ("Extract file not found.")
End If
OpenExtract = ActiveWorkbook.Name
End Function
Function SortFile()
'
' Macro3 Macro
'
Workbooks(SIMFILE).Activate
Sheets(SIMSHEET).Rows("3:3").Select
If Not ActiveSheet.AutoFilter Is Nothing Then
'A filter exist
Selection.AutoFilter
Selection.AutoFilter
Else
Selection.AutoFilter
End If
ActiveWorkbook.Worksheets(SIMSHEET).AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets(SIMSHEET).AutoFilter.Sort.SortFields.Add Key:=Range( _
"B3"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets(SIMSHEET).AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Workbooks(EXTRACTFILE).Activate
Sheets(EXTRACTSHEET).Rows("2:2").Select
If Not ActiveSheet.AutoFilter Is Nothing Then
'A filter exist
Selection.AutoFilter
Selection.AutoFilter
Else
Selection.AutoFilter
End If
ActiveWorkbook.Worksheets(EXTRACTSHEET).AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets(EXTRACTSHEET).AutoFilter.Sort.SortFields.Add Key:=Range( _
"A2"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets(EXTRACTSHEET).AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Workbooks(SIMFILE).Activate
SortFile = 1
End Function
Public Function checkMPM(SIMCount As Integer, EXTRACTCount As Integer)
checkMPM = Workbooks(EXTRACTFILE).Worksheets(EXTRACTSHEET).Cells(EXTRACTCount, 52).Value = MPM
End Function
Function Clean_modification() ' Vide le tableau des modifications
Dim i As Integer
i = 4
Do While Workbooks(SIMFILE).Sheets(MODIFICATIONSHEET).Cells(i, 2).Value <> ""
Workbooks(SIMFILE).Sheets(MODIFICATIONSHEET).Rows(i).EntireRow.Delete
Loop
End Function
Sub FillFormule()
Dim i As Integer
i = 4
Sheets(SIMSHEET).Select
Do While Cells(i, 1).Value <> ""
If Cells(i, 1) = 0 Then
Range("BA" & i).Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC55,Tables!R2C51:R6C52,2,FALSE)"
Range("BB" & i).Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-36],Tables!R2C1:R86C5,2,FALSE)"
Range("BC" & i).Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-37],Tables!R2C1:R86C5,4,FALSE)"
Range("BD" & i).Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-38],Tables!R2C1:R86C5,5,FALSE)"
Range("BE" & i).Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-48],Tables!R2C28:R21C29,2,0)"
Range("BF" & i).Select
ActiveCell.FormulaR1C1 = _
"=IF(ISERROR(VLOOKUP(RC[-43],Tables!R2C39:R48C45,2,FALSE)),""Others"",VLOOKUP(RC[-43],Tables!R2C39:R48C45,2,FALSE))"
Range("BG" & i).Select
ActiveCell.FormulaR1C1 = _
"=IF(ISERROR(VLOOKUP(RC[-44],Tables!R2C39:R48C45,3,FALSE)),""Others"",VLOOKUP(RC[-44],Tables!R2C39:R48C45,3,FALSE))"
Range("BH" & i).Select
ActiveCell.FormulaR1C1 = _
"=IF(ISERROR(VLOOKUP(RC[-45],Tables!R2C39:R48C45,4,FALSE)),""Others"",VLOOKUP(RC[-45],Tables!R2C39:R48C45,4,FALSE))"
Range("BI" & i).Select
ActiveCell.FormulaR1C1 = _
"=IF(ISERROR(VLOOKUP(RC[-46],Tables!R2C39:R48C45,7,FALSE)),""Others"",VLOOKUP(RC[-46],Tables!R2C39:R48C45,7,FALSE))"
Range("BJ" & i).Select
ActiveCell.FormulaR1C1 = _
"=IF(AND(RC[1]=""MEC"",RC[2]=""NEC"",RC[-52]<>""CANCELLED""),""ACCESS"",""Other"")"
Range("BK" & i).Select
ActiveCell.FormulaR1C1 = _
"=IFERROR(VLOOKUP(RC[-32],Tables!R2C35:R244C36,2,FALSE),"""")"
Range("BL" & i).Select
ActiveCell.FormulaR1C1 = _
"=IFERROR(VLOOKUP(RC[-28],Tables!R2C35:R244C36,2,FALSE),"""")"
Range("BM" & i).Select
ActiveCell.FormulaR1C1 = "=YEAR(RC[-27])"
Range("BN" & i).Select
ActiveCell.FormulaR1C1 = "=RC[-27]*RC[-24]/100"
Range("BO" & i).Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-2]= R2C[-2],IF(RC[-57]=""REC"",IF(RC11=""YES - SPOT"", RC[-24],( RC[-24]*(13-MONTH(RC[-29]))/12)),0),0)"
Range("BP" & i).Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-3]= R2C[-3]-1,(IF(RC[-58]=""NRC"",0,IF(RC11=""YES - SPOT"",0,(( RC[-25]/12)*(12-(13-MONTH(RC[-30])))*(1+(RC[-24]/100)))))),0)"
Range("BQ" & i).Select
ActiveCell.FormulaR1C1 = _
"=IF(RC68<>0,IF(MONTH(RC38)>R3C,RC43*(1+(RC44/100))/12,0),IF(RC67<>0,IF(MONTH(RC38)<=R3C,IF(RC11=""YES - REC"",RC43/12,IF(MONTH(RC38)= R3C,RC67,0)),0),0))"
Range("BR" & i).Select
ActiveCell.FormulaR1C1 = _
"=IF(RC68<>0,IF(MONTH(RC38)>R3C,RC43*(1+(RC44/100))/12,0),IF(RC67<>0,IF(MONTH(RC38)<=R3C,IF(RC11=""YES - REC"",RC43/12,IF(MONTH(RC38)= R3C,RC67,0)),0),0))+RC[-1]"
Range("BS" & i).Select
ActiveCell.FormulaR1C1 = _
"=IF(RC68<>0,IF(MONTH(RC38)>R3C,RC43*(1+(RC44/100))/12,0),IF(RC67<>0,IF(MONTH(RC38)<=R3C,IF(RC11=""YES - REC"",RC43/12,IF(MONTH(RC38)= R3C,RC67,0)),0),0))+RC[-1]"
Range("BT" & i).Select
ActiveCell.FormulaR1C1 = _
"=IF(RC68<>0,IF(MONTH(RC38)>R3C,RC43*(1+(RC44/100))/12,0),IF(RC67<>0,IF(MONTH(RC38)<=R3C,IF(RC11=""YES - REC"",RC43/12,IF(MONTH(RC38)= R3C,RC67,0)),0),0))+RC[-1]"
Range("BU" & i).Select
ActiveCell.FormulaR1C1 = _
"=IF(RC68<>0,IF(MONTH(RC38)>R3C,RC43*(1+(RC44/100))/12,0),IF(RC67<>0,IF(MONTH(RC38)<=R3C,IF(RC11=""YES - REC"",RC43/12,IF(MONTH(RC38)= R3C,RC67,0)),0),0))+RC[-1]"
Range("BV" & i).Select
ActiveCell.FormulaR1C1 = _
"=IF(RC68<>0,IF(MONTH(RC38)>R3C,RC43*(1+(RC44/100))/12,0),IF(RC67<>0,IF(MONTH(RC38)<=R3C,IF(RC11=""YES - REC"",RC43/12,IF(MONTH(RC38)= R3C,RC67,0)),0),0))+RC[-1]"
Range("BW" & i).Select
ActiveCell.FormulaR1C1 = _
"=IF(RC68<>0,IF(MONTH(RC38)>R3C,RC43*(1+(RC44/100))/12,0),IF(RC67<>0,IF(MONTH(RC38)<=R3C,IF(RC11=""YES - REC"",RC43/12,IF(MONTH(RC38)= R3C,RC67,0)),0),0))+RC[-1]"
Range("BX" & i).Select
ActiveCell.FormulaR1C1 = _
"=IF(RC68<>0,IF(MONTH(RC38)>R3C,RC43*(1+(RC44/100))/12,0),IF(RC67<>0,IF(MONTH(RC38)<=R3C,IF(RC11=""YES - REC"",RC43/12,IF(MONTH(RC38)= R3C,RC67,0)),0),0))+RC[-1]"
Range("BY" & i).Select
ActiveCell.FormulaR1C1 = _
"=IF(RC68<>0,IF(MONTH(RC38)>R3C,RC43*(1+(RC44/100))/12,0),IF(RC67<>0,IF(MONTH(RC38)<=R3C,IF(RC11=""YES - REC"",RC43/12,IF(MONTH(RC38)= R3C,RC67,0)),0),0))+RC[-1]"
Range("BZ" & i).Select
ActiveCell.FormulaR1C1 = _
"=IF(RC68<>0,IF(MONTH(RC38)>R3C,RC43*(1+(RC44/100))/12,0),IF(RC67<>0,IF(MONTH(RC38)<=R3C,IF(RC11=""YES - REC"",RC43/12,IF(MONTH(RC38)= R3C,RC67,0)),0),0))+RC[-1]"
Range("CA" & i).Select
ActiveCell.FormulaR1C1 = _
"=IF(RC68<>0,IF(MONTH(RC38)>R3C,RC43*(1+(RC44/100))/12,0),IF(RC67<>0,IF(MONTH(RC38)<=R3C,IF(RC11=""YES - REC"",RC43/12,IF(MONTH(RC38)= R3C,RC67,0)),0),0))+RC[-1]"
Range("CB" & i).Select
ActiveCell.FormulaR1C1 = _
"=IF(RC68<>0,IF(MONTH(RC38)>R3C,RC43*(1+(RC44/100))/12,0),IF(RC67<>0,IF(MONTH(RC38)<=R3C,IF(RC11=""YES - REC"",RC43/12,IF(MONTH(RC38)= R3C,RC67,0)),0),0))+RC[-1]"
Range("CC" & i).Value = 0
Range("CD" & i).Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-75],Tables!R2C48:R10C49,2,FALSE)"
Range("DG" & i).Select
ActiveCell.FormulaR1C1 = _
"=IF(C[-101]<>""NRC"",IF(C[-100] <> ""YES - SPOT"",RC[-71],IF(RC[-46]=R2C65,RC[-71],0)),0)"
Range("DF" & i).Select
ActiveCell.FormulaR1C1 = _
"=IF(C[-100]<>""NRC"",IF(C[-99] <> ""YES - SPOT"",(RC[-70]/12)*(13-MONTH(RC[-72])),IF(RC[-45]=R2C65,RC[1],0)),0)"
End If
i = i + 1
Loop
End Sub
Sub Update()
Dim SIM, EXTRACT As String
SIM = ""
EXTRACT = ""
'File
SIMFILE = ActiveWorkbook.Name 'SIMFILE devient le nouveau nom de ce classeur
' déclaration des variables
Dim start As Single
Dim temps As Integer
Dim emptyVar As Integer
Dim partialName As String
Dim NomFichier As String
Dim SIMCount As Integer
Dim EXTRACTCount As Integer
NomFichier = "_SIM_new_Frédéric.xlsm"
SIMCount = 4
EXTRACTCount = 3
partialName = "*OTTO_data_Patrizio*"
'MPM ne semble pas déclaré
MPM = "F. Mathelot"
SIMSHEET = "OTTO"
EXTRACTSHEET = "Global without cancelled"
MODIFICATIONSHEET = "Modifications"
SUPPRESSIONSHEET = "Deleted rows"
'Index
MODIFICATION = 4
Dim i As Integer
i = 4
Do While Workbooks(SIMFILE).Sheets(SUPPRESSIONSHEET).Cells(i, 2).Value <> ""
i = i + 1
Loop
SUPPRIMEE = i
'OPEN
EXTRACTFILE = OpenExtract(partialName)
Workbooks(SIMFILE).Activate
If EXTRACTFILE <> SIMFILE Then
If MsgBox("Are you sure you want to update the file with the extraction " & EXTRACTFILE & " ?", vbYesNo, "Demande de confirmation") = vbYes Then
' Application.Calculation = xlManual
Application.ScreenUpdating = False
Range("A1").Value = Date
'SORT
emptyVar = SortFile
'CHECK
Clean_modification
start = Timer
Do While Workbooks(EXTRACTFILE).Worksheets(EXTRACTSHEET).Cells(EXTRACTCount, 1).Value <> "" Or Workbooks(SIMFILE).Worksheets(SIMSHEET).Cells(SIMCount, 2).Value <> ""
SIM = Workbooks(SIMFILE).Worksheets(SIMSHEET).Cells(SIMCount, 2).Value
EXTRACT = Workbooks(EXTRACTFILE).Worksheets(EXTRACTSHEET).Cells(EXTRACTCount, 1).Value
If SIM <> "" Then
If EXTRACT <> "" Then
Select Case (EXTRACT)
Case Is > SIM:
SuppressionSub (SIMCount)
Case Is = SIM:
emptyVar = ModficationSub(EXTRACTCount, SIMCount)
EXTRACTCount = EXTRACTCount + 1
SIMCount = SIMCount + 1
Case Is < SIM:
If checkMPM(SIMCount, EXTRACTCount) Then
emptyVar = InsertionSub(EXTRACTCount, SIMCount)
EXTRACTCount = EXTRACTCount + 1
SIMCount = SIMCount + 1
Else
EXTRACTCount = EXTRACTCount + 1
End If
End Select
Else
SuppressionSub (SIMCount)
End If
Else
If checkMPM(SIMCount, EXTRACTCount) Then
emptyVar = InsertionSub(EXTRACTCount, SIMCount)
EXTRACTCount = EXTRACTCount + 1
SIMCount = SIMCount + 1
Else
EXTRACTCount = EXTRACTCount + 1
End If
End If
Loop
Workbooks(SIMFILE).Activate
FillFormule
Application.ScreenUpdating = True
'Application.Calculation = xlCalculationAutomatic
temps = Timer - start
Sheets(SIMSHEET).Range("B1").Value = EXTRACTFILE & " - " & temps & " secondes."
MsgBox "File updated successfully. Duration of treatment: " & temps & " secondes " & Chr(13) & " File save as '" & Replace(Format(Sheets(SIMSHEET).Range("A1").Value, "YYYY/MM/dd"), "/", "_") & NomFichier & "'."
'Sauvegarde à la date du jour
ActiveWorkbook.SaveAs Filename:= _
ActiveWorkbook.Path & "\" & Replace(Format(Sheets(SIMSHEET).Range("A1").Value, "YYYY/MM/dd"), "/", "_") & NomFichier _
, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
Else
MsgBox "Update canceled."
End If
Application.DisplayAlerts = False
Workbooks(EXTRACTFILE).Close
Application.DisplayAlerts = True
End If
End Sub
Salut,
Au vu de la longueur de ton code il va être difficile de l'analyser sans les fichiers de base...
Mais déjà au premier coup d’œil je vois qu'il y a des select et des activate partout... C'est très lent dès lors que ce type d'instructions est utilisé...
Autre chose, essaye ça aussi : https://www.excel-pratique.com/fr/astuces_vba/screenupdating.php tu vas gagner un peu de temps déjà.
Girodo
Bonjour,
Petit préalable : un tel volume de code non placé sous balises Code, je ne commence même pas à le lire...
Et si par la suite il se révèle non indenté, cela risque d'être un handicap supplémentaire certain...
Sinon, en vue panoramique, il y aura pas mal de travail pour faire maigrir drastiquement ce code !
Comme l'a déjà soulevé Girodo, il conviendra d'éradiquer les Select-Activate... et épurer un certain nombre de lignes qui semblent sorties tout droit de l'enregistreur, faire disparaître les formules, éliminer les copier-coller, mettre sous bloc With les références répétées, utiliser tableaux et boucles... Ceci pour ce que l'on voit sans creuser. Il restera ensuite à optimiser un peu plus et éventuellement détecter les causes de la lenteur...
Car si 40 minutes c'est une anomalie, dont la source sera éventuellement à chercher, 1 minute c'est déjà très long, trop, et ça mérite que l'on si penche pour ramener l'exécution à une durée plus normale !
Cordialement.
NB- Tu aurais intérêt, outre fournir un fichier comme déjà demandé, à indiquer ce que doit faire ton programme... car je subodore que le déduire de ton code sera une opération quelque peu pénible...
Salut Girodo,
Je te remercie pour tes conseils. Par contre, étant novice en VBA, comment remplacer les Select et Activate ?
Bonjour MrFerrand,
Oui je conçois que ça soit imbuvable car en "vrac".
Je ne peux pas encore transmettre le fichier car je ne l'ai pas anonymé.
L'idée générale de la macro :
Il y a 2 fichiers Excel, on cherche à comparer 12 colonnes de la feuille du premier avec 12 même colonnes de la feuille du second.
Ceci dans le but d'avoir sur un nouveau fichier Excel les lignes étant différentes.
C'est à dire avoir les 12 colonnes (avec le même entête) mais uniquement avec les lignes étant différentes d'un fichier à l'autre.
Je ne sais pas si vous connaissez une manière beaucoup plus simple de faire cela ?
Encore merci à vous.
Petite précision, on souhaite avoir les résultats triés par identifiants (composé de chiffres et de lettre) et les 2 Excels contiennent 150 000 dans chaque colonne.
Il faut savoir quels sont les critères qui décident lignes différentes... Même ligne est-ce identité sur les 12 colonnes ? Où certains champs sont décisifs ?
MrFerrand,
Une ligne est considérée comme différente lorsqu'au moins 1 champ des 12 colonnes est différent.
Le but étant d'obtenir un fichier contenant les lignes classées par ID ayants au moins une différence sur l'une des 12 colonnes. (Sachant que l'ID contient chiffres et lettres).
Merci à vous,
Soit on considère qu'il y a doublon si les 12 colonnes sont identiques ! Ok !
A suivre...