Romai
XLDnaute Junior
Bonjour le forum,
J'ai une macro qui me permet d'importé des fichiers CSV (60 fichiers de 10000lignes). Cette macro fonctionne correctement.
Le problème est que ma macro a mis 28 minute a se faire ce matin.
Comment faire pour gagner du temps?
si quelqu'un peu m'aider merci beaucoups
J'ai une macro qui me permet d'importé des fichiers CSV (60 fichiers de 10000lignes). Cette macro fonctionne correctement.
Le problème est que ma macro a mis 28 minute a se faire ce matin.
VB:
Dim Message, Style, Titre
Dim DossierCsv, K As String
i = 0
On Error GoTo fin
Sheets("HOME").Select
Columns("K:K").Select
Selection.ClearContents
Message = "Please specify the folder containing the CSV files" & vbCrLf & "Press OK to select the folder"
Style = vbOK
Titre = "Importation CSV"
Response = MsgBox(Message, Style, Titre)
If Response = vbOK Then ' L'utilisateur a choisi OK.
Application.FileDialog(msoFileDialogFolderPicker).Show
DossierCsv = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)
'Arrêt du rafraichissement de l'écran
Application.ScreenUpdating = False
'Incrementation du numero de fichier.
For i = 0 To 60
varnomfichier = "SA0000" & i
If i >= 10 Then
varnomfichier = "SA000" & i
End If
If i >= 100 Then
varnomfichier = "SA00" & i
End If
Sheets(varnomfichier).Select
'Destignation à la ligne trouvé précèdement.
K = "$A$3"
'Importation du fichier préselectionné à la place prédefini.
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & DossierCsv & "\" & varnomfichier & ".csv", _
Destination:=Range(K))
.Name = varnomfichier
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 850
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(5, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
'Apres importation, on supprime la premier ligne du fichier contenant le nom des colonnes.
Rows(3).Select
Selection.Delete Shift:=xlUp
'extraire sans doublon
'Columns("R:R").Select 'vider la colonne pour extraire
'Selection.ClearContents
'J = 3
' valcell = ActiveSheet.Range("R3").Value 'valcell est la valeur de la celule precedente
'For Nbligne = 3 To 10004
' valligne = Cells(Nbligne, 1)
' If valligne <> valcell Then
' valcell = valligne
' numcell = "R" & J
' Range(numcell).Formula = valcell
' J = J + 1
' End If
' If valligne = "" Then Exit For
'Next Nbligne
'copier la liste des dates sur la feuille acceuil
'Range("R3:" & numcell).Select
'Selection.Copy
'Sheets("HOME").Select
'NBdate = Cells(1, 13)
'NBdate = NBdate + 1
'Range("K" & NBdate).Select
'ActiveSheet.Paste
Next i
End If
fin:
Sheets("HOME").Select
MsgBox ("Number of imported files :" & i)
End SubComment faire pour gagner du temps?
si quelqu'un peu m'aider merci beaucoups
