Mise à jour via database - cherche solution pour optimiser/rendre + rapide
G
Bonjour à tous,
Nouveau sur le forum, je me suis déjà souvent aidé de réponses postées pour avancer dans mes travaux.
Je me décide à créer un post pour vous demander de l'aide pour optimiser un code qui me sert à mettre à jour des données dans un fichier de reporting, à l'ouverture de celui-ci.
Le code met à jour les données via une procédure ODBB et ajoute différentes colonnes de calcul.
L'exécution du code est trop lente, cela prend plus d'une minute.
Je ne suis pas un pro du VBA. J'arrive à mes fins en m'aidant sur Internet, mais ici je ne vois plus trop comment optimiser.
Voici le code en question :
Sub RequeteClasseurFermedb_prev()
Sheets("db").Visible = True
Sheets("db").ListObjects("Table10").Delete
Sheets("db").Cells.ClearContents
Set WBE = ActiveWorkbook
Dim Cn As ADODB.Connection
Dim Fichier As String
Dim NomFeuille As String, texte_SQL As String
Dim Rst As ADODB.Recordset
'Définit le classeur fermé (vérifie s'il est déjà ouvert effectue une copie, sinon ne va pas) servant de base de données
Dim fso As Object
test = 0
If IsFileOpen("\\WAVDSNTP001.BIO.CORPNET1.COM\_LIS\3000-Planif\3300-Planning\3320-Wavre\PLANNING QC.xlsb") Then
Set fso = CreateObject("Scripting.FileSystemObject")
fso.CopyFile "\\WAVDSNTP001.BIO.CORPNET1.COM\_LIS\3000-Planif\3300-Planning\3320-Wavre\PLANNING QC.xlsb", "\\WAVDSNTP001.BIO.CORPNET1.COM\_LIS\3000-Planif\3300-Planning\3320-Wavre\PLANNING QC_copy.xlsb"
Fichier = "\\WAVDSNTP001.BIO.CORPNET1.COM\_LIS\3000-Planif\3300-Planning\3320-Wavre\PLANNING QC_copy.xlsb"
test = 1
Else
Fichier = "\\WAVDSNTP001.BIO.CORPNET1.COM\_LIS\3000-Planif\3300-Planning\3320-Wavre\PLANNING QC.xlsb"
End If
'Nom de la feuille dans le classeur fermé
NomFeuille = "QC"
Set Cn = New ADODB.Connection
'--- Connection ---
With Cn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.ConnectionString = "Data Source=" & Fichier & ";Extended Properties=""Excel 12.0 Xml;HDR=no;IMEX=1;Readonly=Yes"""
.Open
End With
'-----------------
'Définit la requête.
'/!\ Attention à ne pas oublier le symbole $ après le nom de la feuille.
texte_SQL = "SELECT * FROM [" & NomFeuille & "$]"
Set Rst = New ADODB.Recordset
Set Rst = Cn.Execute(texte_SQL)
With WBE.Sheets("db")
.Range("A1").CopyFromRecordset Rst
End With
'--- Fermeture connexion ---
Cn.Close
Set Cn = Nothing
If test = 1 Then
Kill "\\WAVDSNTP001.BIO.CORPNET1.COM\_LIS\3000-Planif\3300-Planning\3320-Wavre\PLANNING QC_copy.xlsb"
Else
End If
'ajuste le résultat de la requête dans les db
With WBE.Sheets("db")
.Activate
.ListObjects.Add(xlSrcRange, Cells(1).CurrentRegion, , xlYes).Name = "Table10"
lon = .Range("AS65555").End(xlUp).Row
.Columns("N").NumberFormat = "dd/mm/yyyy"
.Columns("N").TextToColumns Destination:=.Columns("N"), DataType:=xlDelimited _
, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 4), TrailingMinusNumbers:=True
.Columns("O").NumberFormat = "dd/mm/yyyy"
.Columns("O").TextToColumns Destination:=.Columns("O"), DataType:=xlDelimited _
, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 4), TrailingMinusNumbers:=True
.Columns("P").NumberFormat = "dd/mm/yyyy"
.Columns("P").TextToColumns Destination:=.Columns("P"), DataType:=xlDelimited _
, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 4), TrailingMinusNumbers:=True
.Columns("AG").NumberFormat = "dd/mm/yyyy"
.Columns("AG").TextToColumns Destination:=.Columns("AG"), DataType:=xlDelimited _
, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 4), TrailingMinusNumbers:=True
.Columns("AI").NumberFormat = "dd/mm/yyyy"
.Columns("AI").TextToColumns Destination:=.Columns("AI"), DataType:=xlDelimited _
, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 4), TrailingMinusNumbers:=True
.Columns("AN").NumberFormat = "dd/mm/yyyy"
.Columns("AN").TextToColumns Destination:=.Columns("AN"), DataType:=xlDelimited _
, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 4), TrailingMinusNumbers:=True
.Columns("AO").NumberFormat = "dd/mm/yyyy"
.Columns("AO").TextToColumns Destination:=.Columns("AO"), DataType:=xlDelimited _
, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 4), TrailingMinusNumbers:=True
.Columns("AA").NumberFormat = "dd/mm/yyyy"
.Columns("AA").TextToColumns Destination:=.Columns("AA"), DataType:=xlDelimited _
, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 4), TrailingMinusNumbers:=True
.Columns("AB").NumberFormat = "dd/mm/yyyy"
.Columns("AB").TextToColumns Destination:=.Columns("AB"), DataType:=xlDelimited _
, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 4), TrailingMinusNumbers:=True
.Columns("AS").TextToColumns Destination:=.Columns("AS"), _
DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter _
:=False, Tab:=True, Semicolon:=False, Comma:=False, Space:=False, _
Other:=False, FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
.Columns("AC").TextToColumns Destination:=.Columns("AC"), DataType:=xlDelimited, TextQualifier _
:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:= _
False, Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1) _
, TrailingMinusNumbers:=True
'ajoute les colonnes de calcul des jours
.Columns("AU").Insert Shift:=xlToLeft
.Range("AU1") = "moiskpi"
.Range("AU2").FormulaR1C1 = "=IF([@[Date réalisé]]<>"""",MONTH([@[Date réalisé]]),"""")"
.Range("AU2:AU" & lon) = .Range("AU2:AU" & lon).Value
.Columns("AV").Insert Shift:=xlToLeft
.Range("AV1") = "PMEXCMEX"
.Range("AV2").FormulaR1C1 = "=IF([@[Date TECO]]<>"""",NETWORKDAYS.INTL([@[Date TECO]],[@[Date de fin SAP]]),NETWORKDAYS.INTL(date,[@[Date de fin SAP]]))"
.Range("AV2:AV" & lon) = .Range("AV2:AV" & lon).Value
.Columns("AW").Insert Shift:=xlToLeft
.Range("AW1") = "délaiTECO"
.Range("AW2").FormulaR1C1 = "=IF([@Statut]=""terminé"",NETWORKDAYS.INTL([@[Date réalisé]],date)-1,0)"
.Range("AW2:AW" & lon) = .Range("AW2:AW" & lon).Value
.Columns("AX").Insert Shift:=xlToLeft
.Range("AX1") = "moisdatefin"
.Range("AX2").FormulaR1C1 = "=IF([@[Date de fin SAP]]<>"""",MONTH([@[Date de fin SAP]]),"""")"
.Range("AX2:AX" & lon) = .Range("AX2:AX" & lon).Value
.Columns("AY").Insert Shift:=xlToLeft
.Range("AY1") = "délaiinterv"
.Range("AY2").FormulaR1C1 = "=IF([@[Date réalisé]]<>"""",""terminé"",IFS(AND([@[Date planifiée]]<>"""",[@[Date planifiée]]-[@[Date de fin SAP]]>=-1),""risque élevé"",AND([@[Date planifiée]]<>"""",[@[Date planifiée]]-[@[Date de fin SAP]]>=-3),""risque moyen"",AND([@[Date planifiée]]<>"""",[@[Date planifiée]]-[@[Date de fin SAP]]>=-5),""risque faible"",AND([@[Date planifiée]]<>"""",[@[Date planif" & _
"iée]]-[@[Date de fin SAP]]<-5),""risque nul"",[@[Date planifiée]]="""",""risque élevé""))" & _
""
.Range("AY2:AY" & lon) = .Range("AY2:AY" & lon).Value
.Range("AZ1") = "tri1"
.Range("AZ2").FormulaR1C1 = "=IF(AND(COUNTIFS([SAP],RC[-51],[Date planifiée],RC[-38],[technicien prévu],RC[-35],[Order type],""CM01"")+COUNTIFS([SAP],RC[-51],[Date planifiée],RC[-38],[technicien prévu],RC[-35],[Order type],""PRWO"")=2,RC[-46]=""PRWO""),0,1)"
.Range("AZ2:AZ" & lon) = .Range("AZ2:AZ" & lon).Value
.Range("BA1") = "tri2"
.Range("BA2").FormulaR1C1 = "=IFERROR(IF([Date planifiée]<=date-1,1,0),1)"
.Range("BA2:BA" & lon) = .Range("BA2:BA" & lon).Value
.Columns("BB").Insert Shift:=xlToLeft
.Range("BB1") = "lastcomment"
.Range("BB2").FormulaR1C1 = "=IFERROR(RIGHT(RC[-36],LEN(RC[-36])-FIND(""@"",SUBSTITUTE(RC[-36],"";"",""@"",LEN(RC[-36])-LEN(SUBSTITUTE(RC[-36],"";"",""""))),1)),"""")"
.Range("BB2:BB" & lon) = .Range("BB2:BB" & lon).Value
.Columns("BC").Insert Shift:=xlToLeft
.Range("BC1") = "annéeKPI"
.Range("BC2").FormulaR1C1 = "=IF([@[Date réalisé]]<>"""",year([@[Date réalisé]]),"""")"
.Range("BC2:BC" & lon) = .Range("BC2:BC" & lon).Value
.Columns("BD").Insert Shift:=xlToLeft
.Range("BD1") = "temps théorique"
.Range("BD2").FormulaR1C1 = "=SUMIFS(dbtemps!C6,dbtemps!C2,[@SAP],dbtemps!C[-51],[@[Type d''intervention]])"
.Range("BD2:BD" & lon) = .Range("BD2:BD" & lon).Value
'ajoute les colonnes de calcul des jours
.Columns("BE").Insert Shift:=xlToLeft
.Range("BE1") = "diag"
.Range("BE2:BE" & Range("AS65555").End(xlUp).Row).FormulaR1C1 = _
"=IF([@[Order type]]<>""cowo"","""",IF(IF(RC40<>0,NETWORKDAYS.INTL(RC35,RC40,,Absences),NETWORKDAYS.INTL(RC35,NOW(),,Absences))<=1,1,IF(RC40<>0,NETWORKDAYS.INTL(RC35,RC40,,Absences)-1,NETWORKDAYS.INTL(RC35,NOW(),,Absences)-1)))"
.Range("BE2:BE" & lon) = .Range("BE2:BE" & lon).Value
.Columns("BF").Insert Shift:=xlToLeft
.Range("BF1") = "repair"
.Range("BF2:BF" & Range("AS65555").End(xlUp).Row).FormulaR1C1 = _
"=IF([@[Order type]]<>""cowo"","""",IF(IF(RC33<>0,NETWORKDAYS.INTL(RC35,RC33,,Absences),NETWORKDAYS.INTL(RC35,NOW(),,Absences))<=1,1,IF(RC33<>0,NETWORKDAYS.INTL(RC35,RC33,,Absences)-1,NETWORKDAYS.INTL(RC35,NOW(),,Absences)-1)))"
.Range("BF2:BF" & lon) = .Range("BF2:BF" & lon).Value
.Columns("BG").Insert Shift:=xlToLeft
.Range("BG1") = "groupe diag"
.Range("BG2:BG" & Range("AS65555").End(xlUp).Row).FormulaR1C1 = _
"=IF([@[Order type]]<>""cowo"","""",IF(RC57=1,""1 jour"",IF(RC57<=3,""2 - 3 jours"",IF(RC57<=5,""3 - 4 jours"","">5 jours""))))"
.Range("BG2:BG" & lon) = .Range("BG2:BG" & lon).Value
.Columns("BH").Insert Shift:=xlToLeft
.Range("BH1") = "groupe repair"
.Range("BH2:BH" & Range("AS65555").End(xlUp).Row).FormulaR1C1 = _
"=IF([@[Order type]]<>""cowo"","""",IF(RC58=1,""1 jour"",IF(RC58<=3,""2 - 3 jours"",IF(RC58<=5,""3 - 4 jours"","">5 jours""))))"
.Range("BH2:BH" & lon) = .Range("BH2:BH" & lon).Value
'converti en valeur et reformatte
.Range("BE2:BE" & lon).Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Selection.TextToColumns Destination:=.Range("BE2:BE" & lon), _
DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter _
:=False, Tab:=True, Semicolon:=False, Comma:=False, Space:=False, _
Other:=False, FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
.Range("BF2:BF" & lon).Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Selection.TextToColumns Destination:=.Range("BF2:BF" & lon), _
DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter _
:=False, Tab:=True, Semicolon:=False, Comma:=False, Space:=False, _
Other:=False, FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
End With
Sheets("db").Visible = False
End Sub
Function IsFileOpen(filename As String)
Dim filenum As Integer, errnum As Integer
On Error Resume Next ' Turn error checking off.
filenum = FreeFile() ' Get a free file number.
' Attempt to open the file and lock it.
Open filename For Input Lock Read As #filenum
Close filenum ' Close the file.
errnum = Err ' Save the error number that occurred.
On Error GoTo 0 ' Turn error checking back on.
' Check to see which error occurred.
Select Case errnum
' No error occurred.
' File is NOT already open by another user.
Case 0
IsFileOpen = False
' Error number for "Permission Denied."
' File is already opened by another user.
Case 70
IsFileOpen = True
' Another error occurred.
Case Else
Error errnum
End Select
End FunctionMerci d'avance pour vos idées.
G
personne n'a d'idée ?
Bonjour et bienvenue,
Regarde du côté de Power Query pour importer les données de ton fichier.
Cdlt.