Microsoft 365 Boucle pour créer un import de fichier csv

Columbo · 25 Juillet 2021

Bonjour à tous,
J'ai un fichier qui cumule des informations sur plusieurs factures (onglet test)
Le résultat que je dois avoir pour chaque facture dans l'onglet Data :
1 ligne E par facture
1 ligne RH par ligne de facture
1 ligne RU par ligne de facture
La macro que je viens de créer boucle bien sur les lignes RH et RU, mais la boucle sur la ligne E ramène également une ligne à blanc (en trop)
Savez-vous comment corriger le code pour que dans la boucle sur la ligne E ne ramène plus une ligne à blanc?

Cordialement

job75 · 24 Août 2021

Columbo à dit:
Est-ce qu'il existe un moyen de ne pas créé les points virgules à la fin?

Normalement dans un fichier CSV on ne touche pas aux points-virgules en fin de ligne.

Mais on peut facilement les supprimer, voyez ce fichier (5) et cette boucle :

VB:

        For k = Len(texte) To 1 Step -1
            If Right(texte, 1) = ";" Then texte = Left(texte, k - 1) Else Exit For
        Next k

Compte Supprimé 979 · 26 Juillet 2021

Bonjour Inspecteur

Je ne comprends pas, chez moi cela semble bien fonctionner

@+

Columbo · 26 Juillet 2021

Bonjour BrunoM45,
La macro fonctionne bien sauf que dans le résultat, elle ramène des lignes vides.

Columbo · 26 Juillet 2021

Bonjour à tous,
Je mets un fichier avec le résultat souhaité et le résultat obtenu pour mieux comprendre le besoin.
N'hésitez pas.
Merci

job75 · 26 Juillet 2021

Bonjour Columbo, Bruno, le forum,

Voyez le fichier joint et la boucle Do/Loop modifiée :

VB:

    Do
    
    If MyInput.Cells(r2, 1) <> "" Then
        Mydata.Cells(r1, col + 1) = MyInput.Cells(r2, 1)
        Mydata.Cells(r1, col + 2) = MyInput.Cells(r2, 2)
        Mydata.Cells(r1, col + 3) = MyInput.Cells(r2, 3)
        Mydata.Cells(r1, col + 4) = MyInput.Cells(r2, 4)
        Mydata.Cells(r1, col + 5) = MyInput.Cells(r2, 5)
        Mydata.Cells(r1, col + 6) = MyInput.Cells(r2, 6)
        Mydata.Cells(r1, col + 7) = MyInput.Cells(r2, 7)
        Mydata.Cells(r1, col + 8) = MyInput.Cells(r2, 8)
        Mydata.Cells(r1, col + 9) = MyInput.Cells(r2, 9)
        r1 = r1 + 1
    End If

    If MyInput.Cells(r2, 10) <> "" Then
        Mydata.Cells(r1, col + 1) = MyInput.Cells(r2, 10)
        Mydata.Cells(r1, col + 2) = MyInput.Cells(r2, 11)
        Mydata.Cells(r1, col + 3) = MyInput.Cells(r2, 12)
        Mydata.Cells(r1, col + 4) = MyInput.Cells(r2, 13)
        Mydata.Cells(r1, col + 5) = MyInput.Cells(r2, 14)
        Mydata.Cells(r1, col + 6) = MyInput.Cells(r2, 15)
        Mydata.Cells(r1, col + 7) = MyInput.Cells(r2, 16)
        Mydata.Cells(r1, col + 8) = MyInput.Cells(r2, 17)
        r1 = r1 + 1
    End If
    
    If MyInput.Cells(r2, 18) <> "" Then
        Mydata.Cells(r1, col + 1) = MyInput.Cells(r2, 18)
        Mydata.Cells(r1, col + 2) = MyInput.Cells(r2, 19)
        Mydata.Cells(r1, col + 3) = MyInput.Cells(r2, 20)
        Mydata.Cells(r1, col + 4) = MyInput.Cells(r2, 21)
        Mydata.Cells(r1, col + 5) = MyInput.Cells(r2, 22)
        r1 = r1 + 1
    End If
    
    r2 = r2 + 1
    
    Loop Until MyInput.Cells(r2, 17).Value = ""

J'ai modifié aussi la mesure de la durée d'exécution.

A+

Columbo · 26 Juillet 2021

Bonjour job75,
Merci, ça fonctionne bien.
Est-ce que tu saurais créer un fichier CSV à chaque changement de E?
Sur le fichier joint, j'ai mis en jaune les onglets pour le résultat attendu.
Il faudrait que le nom du fichier CSV prenne le nom de l'onglet également.
Le nom du fichier sera toujours constitué de la même manière (FACT_KEL-176_"numéro de facture").
Le numéro de facture se trouve en colonne D sur la ligne où se trouve le E.
Merci pour ton aide

job75 · 26 Juillet 2021

Columbo à dit:
Est-ce que tu saurais créer un fichier CSV à chaque changement de E?

Bien sûr, voyez ce fichier (2), j'ai revu et simplifié tout le code :

VB:

Sub Macro1()
Dim t#, MyInput As Worksheet, r1&, r2&, col%, deb&, x%, i&, texte$, j%, flag As Boolean

    t = Timer
    Set MyInput = Sheets("test")
    r1 = 1
    r2 = 1
    col = 0
   
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
   
    '---création de la feuille Data---
    Application.DisplayAlerts = False
    On Error Resume Next 'si la feuille n'existe pas
    Sheets("Data").Delete
    On Error GoTo 0
    Sheets.Add After:=Sheets("test")
    ActiveSheet.Name = "Data"
   
    With Sheets("Data")
   
        Do
   
1       If MyInput.Cells(r2, 1) <> "" Or flag Then
            '---création du fichier CSV---
            If deb Then
                x = FreeFile
                Open ThisWorkbook.Path & "\FACT_" & .Cells(deb, col + 2) & "_" & .Cells(deb, col + 4) & ".csv" For Output As #x 'ouverture en écriture séquentielle
                For i = deb To r1 - 1
                    texte = "" 'RAZ
                    For j = 1 To 9: texte = texte & ";" & .Cells(i, col + j): Next j 'concaténation
                    Print #x, Mid(texte, 2)
                Next i
                Close #x
            End If
            If flag Then GoTo 2
            deb = r1 'mémorise la ligne
            For j = 1 To 9: .Cells(r1, col + j) = MyInput.Cells(r2, j): Next j
            r1 = r1 + 1
        End If

        For j = 1 To 8: .Cells(r1, col + j) = MyInput.Cells(r2, 9 + j): Next j
        r1 = r1 + 1
   
        For j = 1 To 5: .Cells(r1, col + j) = MyInput.Cells(r2, 17 + j): Next j
        r1 = r1 + 1
   
        r2 = r2 + 1
   
        Loop Until MyInput.Cells(r2, 17) = ""
       
        flag = True
        GoTo 1 'création du dernier fichier CSV

    End With
   
2   Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
   
    MsgBox "Durée " & Format(Timer - t, "0.00 \sec")
 
End Sub

Edit : il manquait la création du dernier fichier CSV (le 16ème), j'ai corrigé la macro.

Usine à gaz · 26 Juillet 2021

Bonjour à toutes et à tous,
"Bonjour job75,
Merci, ça fonctionne bien.
Est-ce que tu saurais créer un fichier CSV à chaque changement de E?"

LOL : en voilà une question

Columbo · 27 Juillet 2021

Bonjour job75,
Désolé pour le retour tardif.
Excellent!! les 16 fichiers se sont bien crées. Au top la macro
Est-ce normal que les dates soient repris en fomat nombre et non en format date (dd/mm/aaaa)?
Je vais rajouter encore un détails que je n'ai pas mentionner au départ.
Est-ce possible de rajouter un compteur qui compte le nombre de ligne RH et qui met le chiffre dans la cellule J1 de chaque fichier?
Merci pour le travail, ça me soulage pas mal
Cordialement

Columbo · 27 Juillet 2021

Je vais encore abuser : est-ce possible d'avoir 2 macros séparées?
1 qui créée l'onglet data et 1 qui créée les fichiers à partir de l'onglet Data.
Je dois pouvoir modifier si besoin les données de l'onglet Data avant de créer tous les fichiers CSV.
Sur la macro du post #7, on ne peut pas les séparer les 2 actions.
Bravo, tu as simplifié la macro et en plus elle est plus rapide...

job75 · 27 Juillet 2021

Bonsoir Columbo,

Columbo à dit:
Je dois pouvoir modifier si besoin les données de l'onglet Data avant de créer tous les fichiers CSV.

Modifiez plutôt la feuille source "test", c'est plus logique.

A+

job75 · 27 Juillet 2021

Columbo à dit:
Est-ce normal que les dates soient repris en fomat nombre et non en format date (dd/mm/aaaa)?
Je vais rajouter encore un détails que je n'ai pas mentionner au départ.
Est-ce possible de rajouter un compteur qui compte le nombre de ligne RH et qui met le chiffre dans la cellule J1 de chaque fichier?

Voyez ce fichier (3).

Pour les dates c'est de ma faute, j'avais enlevé les .Value, je les ai remises.

job75 · 28 Juillet 2021

Columbo à dit:
Je dois pouvoir modifier si besoin les données de l'onglet Data avant de créer tous les fichiers CSV.

Si vous y tenez vraiment voyez ce fichier (4) et cette macro :

VB:

Sub Fichiers_CSV()
Dim t#, tablo, ub&, i&, n&, j&, jmax&, x%, texte$, k%
t = Timer
On Error Resume Next
tablo = Sheets("Data").[A1].CurrentRegion.Resize(, 9) 'matrice, plus rapide
If Err Then MsgBox "La feuille 'Data' n'existe pas !", 48: Exit Sub
On Error GoTo 0
ub = UBound(tablo)
For i = 1 To ub
    n = n + 1
    For j = i + 1 To ub
        If j = ub Then jmax = j: Exit For
        If tablo(j, 1) = "E" Then jmax = j - 1: Exit For
    Next j
    x = FreeFile
    Open ThisWorkbook.Path & "\FACT_" & tablo(i, 2) & "_" & tablo(i, 4) & ".csv" For Output As #x 'ouverture en écriture séquentielle
    For j = i To jmax
        texte = "" 'RAZ
        For k = 1 To 9: texte = texte & ";" & tablo(j, k): Next k 'concaténation
        texte = texte & ";" & IIf(j = i, "RH = " & (jmax - i) / 2, "")
        Print #x, Mid(texte, 2)
    Next j
    Close #x
    i = jmax
Next i
MsgBox n & " fichier" & IIf(n > 1, "s", "") & " créé" & IIf(n > 1, "s", "") & " en " & Format(Timer - t, "0.00 \sec"), , "Fichiers CSV"
End Sub

Bonne nuit.

Columbo · 28 Juillet 2021

Bonjour job75,
Nickel, ça marche très bien.
Est-ce possible de rajouter un compteur qui compte le nombre de ligne RH et qui met le chiffre dans la cellule J1 de chaque fichier?
Merci encore une fois

job75 · 28 Juillet 2021

Columbo à dit:
Est-ce possible de rajouter un compteur qui compte le nombre de ligne RH et qui met le chiffre dans la cellule J1 de chaque fichier?

Vous n'avez pas testé les fichiers (3) et (4) ni regardé les cellules J1 des fichiers CSV ?

Microsoft 365 Boucle pour créer un import de fichier csv

Columbo

XLDnaute Nouveau

Pièces jointes

job75

Compte Supprimé 979

Guest

Columbo

XLDnaute Nouveau

Columbo

XLDnaute Nouveau

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

Columbo

XLDnaute Nouveau

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

Usine à gaz

XLDnaute Barbatruc

Columbo

XLDnaute Nouveau

Columbo

XLDnaute Nouveau

job75

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

Columbo

XLDnaute Nouveau

job75

XLDnaute Barbatruc

Discussions similaires