XL 2019 Export plusieurs fichiers Excel vers bloc note

Bastien43

XLDnaute Occasionnel
Bonjour,

Je dispose de plusieurs fichiers Excel (100 excel ). Je souhaite pour chacun d'eux, de manière automatisée, en lançant une macro sur l'un d'eux :

- Séparer la date de l'heure (colonne A = date AAAA:MM:JJ et colonne B = heure HH:MM)
- Dans la colonne D : multiplier la pression (colonne C) par 10 pour toutes les valeurs.
- Extraire dans un même fichier bloc note les valeurs de la colonne B (=HH:MM) et la colonne D correspondante (pression en mètre) ; (par contre inutile de reprendre la ligne A des titres de chaque fichier)
- Faire ceci pour chaque fichier excel présent dans le même dossier. Les valeurs s'ajoutent les unes aux autres dans un bloc-note (voir exemple bloc-note ci-joint). Le bloc-note possède déjà des en-têtes :

;Calage en Pression
;Localisation Date Valeur
;--------------------------


et surtout, dès qu'une liste commence (issue d'une feuille excel), il faut la nommer comme la feuille excel en question (voir le bloc- note : "localisation") pour pouvoir s'y retrouver parmi les valeurs qui s'enchaînent.

Est-ce possible svp de créer une macro ? Si c'est complexe, je peux réexpliquer.

Merci pour votre aide.
Cordialement
Bastien
 

Pièces jointes

  • 1.xls
    29.5 KB · Affichages: 9
  • 2.xls
    29.5 KB · Affichages: 5
  • Calage_pression.txt
    133 bytes · Affichages: 4
Solution
Bonjour Bastien43,

Vous ne vous rendez pas compte que la colonne A ne contient pas des dates (nombres) mais des textes ?

Pour calculer la hauteur h cette macro s'appuie donc sur la colonne B :
VB:
Sub Fichier_TXT()
Dim chemin$, fichier$, feuil$, x%, form$, h As Variant, tablo, nom$, n&, i&
chemin = ThisWorkbook.Path & "\" 'dossier à adapter
fichier = Dir(chemin) '1er fichier du dossier
feuil = "FEUILLE_1" 'nom des feuilles à traiter
x = FreeFile
Open chemin & "Calage_pression.txt" For Output As #x 'création du fichier TXT
Print #x, ";Calage en Pression"
Print #x, ";Localisation Heure Valeur"
Print #x, ";--------------------------"
Application.ScreenUpdating = False
Columns(3).Resize(, 2).Insert 'insère 2 colonnes auxiliaires...

job75

XLDnaute Barbatruc
Bonjour Bastien43,

Il y a sur XLD de nombreux exemples de création de fichiers .txt par écriture séquentielle.

On comprend que vous partez de fichiers Excel avec 2 colonnes.

Par contre on ne comprend pas ce que vous voulez obtenir, d'où viennent "73" et "N2" ?

Et les valeurs s'ajoutent comment ?

A+
 

Bastien43

XLDnaute Occasionnel
Bonjour,

Merci, j'ai essayé des méthodes mais je n'ai pas obtenu de bon résultat. 73 et N2 étaient des anciens exemples/tests. Je cherche à mettre le nom de la feuille extraite de chaque excel à la place.
Les valeurs suivent le modèle du bloc note. C'est-à-dire 73 était une première feuille, N2 est la feuille du fichier excel suivant, etc

Merci pour votre aide
 

job75

XLDnaute Barbatruc
C'est-à-dire 73 était une première feuille, N2 est la feuille du fichier excel suivant, etc
J'avais cru comprendre qu'il y avait un fichier .txt pour chaque fichier Excel.

Tout ça n'est pas du tout clair alors joignez 2 fichiers Excel de quelques lignes et le(s) fichiers(s) .txt que vous voulez obtenir, nommé(s) comme il faut, avec les résultats que vous voulez exactement.
 

job75

XLDnaute Barbatruc
Bon je comprends qu'un seul fichier texte est créé.

Et ce n'est pas les noms des feuilles qu'il faut prendre mais les noms des fichiers : 1, 2, 3 etc...

En effet dans les fichiers Excel le nom des feuilles doit toujours être le même pour qu'on puisse les analyser par des formules de liaison.

Voyez les fichiers joints et la macro affectée au bouton :
VB:
Sub Fichier_TXT()
Dim chemin$, fichier$, feuil$, x%, form$, h As Variant, tablo, nom$, n&, i&
chemin = ThisWorkbook.Path & "\" 'dossier à adapter
fichier = Dir(chemin) '1er fichier du dossier
feuil = "FEUILLE_1" 'nom des feuilles à traiter
x = FreeFile
Open chemin & "Calage_pression.txt" For Output As #x 'création du fichier TXT
Print #x, ";Calage en Pression"
Print #x, ";Localisation Date Valeur"
Print #x, ";--------------------------"
Application.ScreenUpdating = False
Columns(3).Resize(, 2).Insert 'insère 2 colonnes auxiliaires
While fichier <> ""
    If Right(fichier, 4) = ".xls" Or Right(fichier, 5) Like ".xls?" Then
        form = "'" & chemin & "[" & fichier & "]" & feuil & "'!"
        h = ExecuteExcel4Macro("MATCH(9^9," & form & "C1)") 'évalue la formule de liaison, C1 => colonne 1
        If IsNumeric(h) Then
            Range("C1").Resize(h).FormulaArray = "=MOD(" & form & "A1:A" & h & ",1)" 'formule de liaison matricielle, plus rapide
            Range("D1").Resize(h).FormulaArray = "=" & form & "B1:B" & h 'formule de liaison matricielle
            tablo = Range("C1").Resize(h, 2) 'matrice, plus rapide
            Range("C1").Resize(h, 2) = tablo 'supprime les formules
            nom = Left(fichier, InStrRev(fichier, ".") - 1) 'nom du fichier sans extension
            n = 0
            For i = 2 To h
                If tablo(i, 1) <> 0 Or tablo(i, 2) <> 0 Then
                    n = n + 1
                    Print #x, IIf(n = 1, nom, "") & vbTab & Format(tablo(i, 1), "hh:mm") & vbTab & tablo(i, 2)
                End If
            Next
        End If
    End If
    fichier = Dir 'fichier suivant
Wend
Close #x 'fermeture du fichier TXT
Columns(3).Resize(, 2).Delete 'supprime les 2 colonnes auxiliaires
End Sub
 

Pièces jointes

  • 1.xls
    51.5 KB · Affichages: 4
  • 2.xls
    29.5 KB · Affichages: 3

Bastien43

XLDnaute Occasionnel
Bonsoir,

Merci beaucoup c'est ce que je recherchais. C'est top merci, merci pour les commentaires pour identifier les étapes
Si je souhaite multiplier les valeurs par 10 de la colonne B (passage de pression en bar à hauteur d'eau en mètre de colonne d'eau), à quel endroit actualiser la macro svp?

Merci
Bastien
 

job75

XLDnaute Barbatruc
Si je souhaite multiplier les valeurs par 10 de la colonne B (passage de pression en bar à hauteur d'eau en mètre de colonne d'eau), à quel endroit actualiser la macro svp?
Remplacer dans la macro du post #6 :
VB:
Range("D1").Resize(h).FormulaArray = "=" & form & "B1:B" & h 'formule de liaison matricielle
par :
Code:
Range("D1").Resize(h).FormulaArray = "=" & form & "B1:B" & h & "*10" 'formule de liaison matricielle
 

Pièces jointes

  • 1.xls
    51.5 KB · Affichages: 3
  • 2.xls
    29.5 KB · Affichages: 2

Bastien43

XLDnaute Occasionnel
Bonjour,

J'ai essayé de garder le premier fichier (le 1 où il y a la macro) et de mettre tous les fichiers dans un même dossier. Pourtant lorsque je lance la macro, seul ces 2 fichiers sont pris et pas les autres ?
Toutes les feuilles se nomment FEUILLE_1. Quel est l'origine du problème ?
Le nom des Feuilles est en lettres et non plus 1 ou 2
Les fichiers ont la même composition. Je joins un exemple

Je ne trouve pas la solution.

Merci pour votre aide
 

Pièces jointes

  • CPT_RIVERIE-PRESSION.xls
    93 KB · Affichages: 4

job75

XLDnaute Barbatruc
Bonjour Bastien43,

Vous ne vous rendez pas compte que la colonne A ne contient pas des dates (nombres) mais des textes ?

Pour calculer la hauteur h cette macro s'appuie donc sur la colonne B :
VB:
Sub Fichier_TXT()
Dim chemin$, fichier$, feuil$, x%, form$, h As Variant, tablo, nom$, n&, i&
chemin = ThisWorkbook.Path & "\" 'dossier à adapter
fichier = Dir(chemin) '1er fichier du dossier
feuil = "FEUILLE_1" 'nom des feuilles à traiter
x = FreeFile
Open chemin & "Calage_pression.txt" For Output As #x 'création du fichier TXT
Print #x, ";Calage en Pression"
Print #x, ";Localisation Heure Valeur"
Print #x, ";--------------------------"
Application.ScreenUpdating = False
Columns(3).Resize(, 2).Insert 'insère 2 colonnes auxiliaires
While fichier <> ""
    If Right(fichier, 4) = ".xls" Or Right(fichier, 5) Like ".xls?" Then
        form = "'" & chemin & "[" & fichier & "]" & feuil & "'!"
        h = ExecuteExcel4Macro("MATCH(9^9," & form & "C2)") 'évalue la formule de liaison, C2 => colonne 2 puisque la colonne 1 contient des textes
        If IsNumeric(h) Then
            Range("C1").Resize(h).FormulaArray = "=MOD(" & form & "A1:A" & h & ",1)" 'formule de liaison matricielle, plus rapide
            Range("D1").Resize(h).FormulaArray = "=" & form & "B1:B" & h & "*10" 'formule de liaison matricielle
            tablo = Range("C1").Resize(h, 2) 'matrice, plus rapide
            Range("C1").Resize(h, 2) = tablo 'supprime les formules
            nom = Left(fichier, InStrRev(fichier, ".") - 1) 'nom du fichier sans extension
            n = 0
            For i = 2 To h
                If tablo(i, 1) <> 0 Or tablo(i, 2) <> 0 Then
                    n = n + 1
                    Print #x, IIf(n = 1, nom, vbTab & vbTab) & vbTab & Format(tablo(i, 1), "hh:mm:ss") & vbTab & tablo(i, 2)
                End If
            Next
        End If
    End If
    fichier = Dir 'fichier suivant
Wend
Close #x 'fermeture du fichier TXT
Columns(3).Resize(, 2).Delete 'supprime les 2 colonnes auxiliaires
End Sub
J'ai aussi ajouté des tabulations pour mieux cadrer.

A+
 

Pièces jointes

  • CPT_RIVERIE-PRESSION.xls
    112.5 KB · Affichages: 9

Bastien43

XLDnaute Occasionnel
Bonjour,

Je vous sollicite à nouveau svp. J'ai récupéré cette fois ci le fichier en pièce jointe. J'en ai plusieurs de ce type. La macro ne s'applique pas.
Je pense que le format de la date pose problème. Où dois je modifier la macro svp ou comment bien préparer les données ? quel format nécessite la macro ? @job75 comment faire ?

Merci par avance pour votre aide
Bastien
 

Pièces jointes

  • 21651.XLS
    41.5 KB · Affichages: 5
Dernière édition:

job75

XLDnaute Barbatruc
Bonjour Bastien43,

Vous utilisez un fichier avec une extension .XLS en majuscules alors il suffit de remplacer :
VB:
    If Right(fichier, 4) = ".xls" Or Right(fichier, 5) Like ".xls?" Then
par :
Code:
    If LCase(Right(fichier, 4)) = ".xls" Or LCase(Right(fichier, 5)) Like ".xls?" Then
A+
 

Pièces jointes

  • 21651.XLS
    61 KB · Affichages: 2

Discussions similaires

Statistiques des forums

Discussions
311 721
Messages
2 081 929
Membres
101 843
dernier inscrit
Thaly