Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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

Columbo

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

Pièces jointes

  • test forum.xlsm
    33.5 KB · Affichages: 20
Solution
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

Columbo

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

Pièces jointes

  • test forum.xlsm
    38.5 KB · Affichages: 5

job75

XLDnaute Barbatruc
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+
 

Pièces jointes

  • test forum(1).xlsm
    26.5 KB · Affichages: 4

Columbo

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

Pièces jointes

  • test forum(1).xlsm
    40.3 KB · Affichages: 4

job75

XLDnaute Barbatruc
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.
 

Pièces jointes

  • test forum(2).xlsm
    27 KB · Affichages: 6
Dernière édition:

Columbo

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

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

XLDnaute Barbatruc
Voyez ce fichier (3).

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

Pièces jointes

  • test forum(3).xlsm
    21.8 KB · Affichages: 4

job75

XLDnaute Barbatruc
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.
 

Pièces jointes

  • test forum(4).xlsm
    34.7 KB · Affichages: 9

Columbo

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

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…