XL 2019 VBA - Copier/Coller de colonnes vers un Excel

[GENTILE]

Bonjour,

Je vous expose mon problème, dans un soucis de récupération et de traitement de données, je souhaite transférer les colonnes du fichier LP - Test.CSV - (Time ; Pressure ; Température et Flow (Vol.)) sur le fichier Excel Test-1, mais seulement les encadrements défini par les horaires de début et fin.

Le simple Copier/Coller avec changement de format de colonne, suppression ... ok je sais faire, mais là je dois avouer que copier des "intervalles" de colonnes avec des fourchettes horaires je ...... PPPffffff pas de mot.

Pourriez-vous m'aider a solutionner ceci s'il vous plaît avec un énorme Merci par avance ?

 

[Hasco]

Bonjour,

Puisque vous avez 2016, voici une solution par requête PowerQuery.
Ne pas oublié de changer le chemin vers votre fichier à l'étape 'Source' de la requêtes 'Données'.

Cordialement

 

[job75]

Bonjour GENTILE, Hasco, le forum,

En VBA une solution très simple et rapide est d'utiliser le filtre avancé :

Sub MAJ()
Application.ScreenUpdating = False
Workbooks.OpenText ThisWorkbook.Path & "\LP - Test.csv", Local:=True 'à adapter
[J2] = "=(C2>=" & Replace(Feuil1.[E3], ",", ".") & ")*(C2<=" & Replace(Feuil1.[E4], ",", ".") & ")"
[A1].CurrentRegion.AdvancedFilter xlFilterCopy, [J1:J2], Feuil1.[B10:E10]
[J2] = "=(C2>=" & Replace(Feuil1.[E6], ",", ".") & ")*(C2<=" & Replace(Feuil1.[E7], ",", ".") & ")"
[A1].CurrentRegion.AdvancedFilter xlFilterCopy, [J1:J2], Feuil1.[G10:J10]
[J2] = "=(C2>=" & Replace(Feuil1.[K3], ",", ".") & ")*(C2<=" & Replace(Feuil1.[K4], ",", ".") & ")"
[A1].CurrentRegion.AdvancedFilter xlFilterCopy, [J1:J2], Feuil1.[L10:O10]
ActiveWorkbook.Close False
End Sub

Téléchargez les fichiers zippés joints dans le même dossier (le bureau).

A+

 

[job75]

Une autre solution, plus compliquée mais plus rapide, consiste à traiter séquentiellement le fichier CSV :

Sub MAJ()
Dim h1#, h2#, h3#, h4#, h5#, h6#, x%, texte$, s, v, n1&, tablo1(), n2&, tablo2(), n3&, tablo3()
h1 = [E3]: h2 = [E4]: h3 = [E6]: h4 = [E7]: h5 = [K3]: h6 = [K4]
x = FreeFile
Open ThisWorkbook.Path & "\LP - Test.csv" For Input As #x
While Not EOF(1) 'EndOfFile : fin du fichier
    Line Input #x, texte
    s = Split(texte, ";")
    v = s(2)
    If IsDate(v) Then 'élimine la 1ère ligne
        v = TimeValue(v)
        If v >= h1 And v <= h2 Then
            ReDim Preserve tablo1(3, n1) 'base 0
            tablo1(0, n1) = v
            tablo1(1, n1) = CDbl(s(4))
            tablo1(2, n1) = CDbl(s(5))
            tablo1(3, n1) = CDbl(s(6))
            n1 = n1 + 1
        End If
        If v >= h3 And v <= h4 Then
            ReDim Preserve tablo2(3, n2) 'base 0
            tablo2(0, n2) = v
            tablo2(1, n2) = CDbl(s(4))
            tablo2(2, n2) = CDbl(s(5))
            tablo2(3, n2) = CDbl(s(6))
            n2 = n2 + 1
        End If
        If v >= h5 And v <= h6 Then
            ReDim Preserve tablo3(3, n3) 'base 0
            tablo3(0, n3) = v
            tablo3(1, n3) = CDbl(s(4))
            tablo3(2, n3) = CDbl(s(5))
            tablo3(3, n3) = CDbl(s(6))
            n3 = n3 + 1
        End If
    End If
Wend
Close #x
'---restitution---
Application.ScreenUpdating = False
With Feuil1 'CodeName
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    .Rows("11:" & .Rows.Count).ClearContents 'RAZ
    If n1 Then .[B11].Resize(n1, 4) = Application.Transpose(tablo1) 'Transpose est limitée à 65536 lignes
    If n2 Then .[G11].Resize(n2, 4) = Application.Transpose(tablo2)
    If n3 Then .[L11].Resize(n3, 4) = Application.Transpose(tablo3)
End With
End Sub

Attention, pour que la macro fonctionne j'ai dû supprimer la dernière colonne (vide) du fichier CSV.

Cette macro s'exécute en 0,04 seconde contre 0,2 seconde pour celle du post précédent, elle est donc 5 fois plus rapide.