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

Columbo

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
job75
Columbo à dit:
Est-ce qu'il existe un moyen de ne pas créé les points virgules à la fin?
Cliquez pour agrandir...
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
Trier par date Trier par votes
job75

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
Vote positif 0 Vote négatif
Columbo

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
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Columbo à dit:
Est-ce que tu saurais créer un fichier CSV à chaque changement de E?
Cliquez pour agrandir...
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:
Vote positif 0 Vote négatif
Columbo

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
 
Vote positif 0 Vote négatif
Columbo

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...
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
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?
Cliquez pour agrandir...
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
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Columbo à dit:
Je dois pouvoir modifier si besoin les données de l'onglet Data avant de créer tous les fichiers CSV.
Cliquez pour agrandir...
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
Vote positif 0 Vote négatif

Discussions similaires

S
  • Résolu(e)
XL 2016 Boucle For ne s'exécute pas comme une boucle et boucle infinie
Réponses
2
Affichages
309
Stéphane_1
S
Mathos
  • Résolu(e)
XL 2021 Copie de certaines données Excel sur Word
2
Réponses
28
Affichages
798
Mathos
Mathos
P
  • Question
Microsoft 365 Joindre un fichier PDF dans un mail + inclure date envoi du mail dans un autre onglet
Réponses
1
Affichages
470
kiki29
kiki29
chris6999
  • Question
Microsoft 365 Boucle VB pour supprimer les caractères spéciaux et numériques d'une chaîne
Réponses
5
Affichages
392
patricktoulon
patricktoulon
G
  • Question
Microsoft 365 Import Donnes issu de fichier CSV
2 3
Réponses
40
Affichages
2 K
laurent950
laurent950
J
  • Question
XL 2021 Résolu - Extractions de valeurs Ligne pour créer des lignes isolées / Macro Séparer Valeurs
Réponses
14
Affichages
376
JM04082023!
J
F
  • Résolu(e)
Microsoft 365 Comment enregistrer chaque ligne en tant que fichier texte dans Excel?
2
Réponses
24
Affichages
708
TooFatBoy
TooFatBoy
J
  • Résolu(e)
XL 2013 Tri de données depuis un CSV
Réponses
5
Affichages
161
dysorthographie
dysorthographie
S
  • Résolu(e)
Microsoft 365 Ecrasement d'une ligne si déjà existante
Réponses
2
Affichages
157
sebastien176
S
J
  • Résolu(e)
XL 2021 Coloriser une cellule avec un click d'une colonne
Réponses
10
Affichages
201
TooFatBoy
TooFatBoy

Membres actuellement en ligne

5 membres et 54 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
315 088
Messages
2 116 087
Membres
112 656
dernier inscrit
VNVT