XL 2019 Export plusieurs fichiers Excel vers bloc note

[Bastien43]

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

 

[job75]

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]

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]

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.

 

[Bastien43]

Bonjour,

Merci pour votre aide. Voici les fichiers. Les secondes peuvent rester.

Cordialement

 

[job75]

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 :

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

 

[Bastien43]

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]

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 :

Range("D1").Resize(h).FormulaArray = "=" & form & "B1:B" & h 'formule de liaison matricielle

par :

Range("D1").Resize(h).FormulaArray = "=" & form & "B1:B" & h & "*10" 'formule de liaison matricielle

 

[Bastien43]

Bonjour,
Merci ca a fonctionné. Merci beaucoup pour votre aide et votre temps.
Cordialement
Bonne journée
Bastien

 

[Bastien43]

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

 

[job75]

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 :

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+

 

[Bastien43]

Bonjour
ok merci je vois la modif
Merci pour la correction
Cordialement

 

[Bastien43]

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

 

[job75]

Bonjour Bastien43,

Vous utilisez un fichier avec une extension .XLS en majuscules alors il suffit de remplacer :

    If Right(fichier, 4) = ".xls" Or Right(fichier, 5) Like ".xls?" Then

par :

    If LCase(Right(fichier, 4)) = ".xls" Or LCase(Right(fichier, 5)) Like ".xls?" Then

A+

 

[Bastien43]

Bonjour,
Merci beaucoup pour votre aide, ça marche
Cordialement
Bonne soirée