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

GENTILE

XLDnaute Nouveau
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 ?
 

Pièces jointes

  • LP - Test.zip
    12.4 KB · Affichages: 4
  • Test-1.xlsx
    16.9 KB · Affichages: 3

Hasco

XLDnaute Barbatruc
Repose en paix
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
 

Pièces jointes

  • Test-1.xlsx
    71.1 KB · Affichages: 1

job75

XLDnaute Barbatruc
Bonjour GENTILE, Hasco, le forum,

En VBA une solution très simple et rapide est d'utiliser le filtre avancé :
VB:
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+
 

Pièces jointes

  • Test(1).zip
    33.6 KB · Affichages: 1

job75

XLDnaute Barbatruc
Une autre solution, plus compliquée mais plus rapide, consiste à traiter séquentiellement le fichier CSV :
VB:
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.
 

Pièces jointes

  • Test(2).zip
    33.3 KB · Affichages: 0

Discussions similaires

Réponses
6
Affichages
362

Statistiques des forums

Discussions
311 720
Messages
2 081 900
Membres
101 834
dernier inscrit
Jeremy06510