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

G
  • Question
Microsoft 365 Import Donnes issu de fichier CSV
2
Réponses
22
Affichages
382
GClaire
G
L
  • Question
VBA : erreur sur boucle
Réponses
2
Affichages
63
Latias
L
M
  • Question
XL 2010 Créer un bouton de restauration
Réponses
12
Affichages
755
mostefa mokhtar
M
C
  • Question
XL 2021 VBA - créer une boucle de calcul pour remplir un tableau à partir de 2 autres sur une même feuille
Réponses
7
Affichages
299
clineM
C
W
  • Question
XL 2021 Double boucle
Réponses
2
Affichages
177
whiteshark
W
A
  • Résolu(e)
XL 2016 Boucle copier-coller
Réponses
8
Affichages
348
AngieMot33
A
A
  • Question
XL 2016 Boucle sur sous répertoire fso.GetFolder SharePoint
Réponses
0
Affichages
263
Aldonanou
A
B
  • Question
XL 2016 Rapatrier le type de liste si références majoritaires au sein de la liste
Réponses
3
Affichages
240
sousou
sousou
L
  • Question
Microsoft 365 Automatisation d'un calendrier de paiement client
2
Réponses
17
Affichages
648
laurabachau
L
chris6999
  • Question
Microsoft 365 MACRO VBA - Extraire des listes à partir d'une boucle
Réponses
5
Affichages
193
chris6999
chris6999

Membres actuellement en ligne

1 membres et 46 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
312 105
Messages
2 085 350
Membres
102 870
dernier inscrit
Armisa