Microsoft 365 Effacer ligne sans date fichier texte via VBA excel

Fred999 · 13 Décembre 2019

Bonjour,

J'ai un petit souci sur un fichier texte que je crée via une macro VBA excel. (voir ci-dessous)
Il fonctionne bien j'ai toutes les infos mais....
J'ai mis un for i=1 to 100 et évidemment quand j'ai moins de 100 à la fin j'ai des lignes avec des caractères incomplet.
est ce qu'il y a moyen de supprimer les lignes ou il n'y a plus de date parce que le nombre de ligne est variable.
D'avance merci pour votre aide, et pour info je ne suis pas un expert en VBA , en voyant mon code vous l'aurez compris 🙂
Merci à vous.

Sub Fichier_Texte()
Dim i
Open "C:\Export\Test1.txt" For Output As #1
For i = 1 To 100
Print #1, String(1, "1"); String(1, " "); String(1, "|"); String(1, " ") & Cells(i, 2);
Print #1, String(8, " ") & Cells(i, 7);
Print #1, String(1, " ") & Cells(i, 8);
Print #1, String(5, " ") & Cells(i, 11);
Print #1, String(1, " "); String(1, "-") & Cells(i, 14);
Print #1, String(6, " ") & Cells(i, 17);
Print #1, String(3, " ") & Cells(i, 20);
Print #1, String(3, " ") & Cells(i, 23);
Print #1, String(3, " ") & Cells(i, 26);
Print #1, String(3, " ") & Cells(i, 29);
Print #1, String(3, " ") & Cells(i, 32);
Print #1, ";"
Next i
Close #1
End Sub

eriiic · 29 Décembre 2019

Bonjour,

je ne vois pas de ligne blanche si ce n'est celles après les données, revois tes explications...
Je ne vois pas trop l'intérêt d'avoir (presque) 3 fois les mêmes données en multipliant les colonnes.
Tu ferais mieux de mettre 10 lignes de données avant modif, et ce que tu veux obtenir après, ça sera plus clair que de faire le tri dans ta macro.
En mettant différents cas de suppression.
Donne aussi la liste de tous les champs (noms) et leur longueur dans le fichier texte.
Par ailleurs, ôte les protections des feuilles.
eric

Edit : teste ça si tu n'as pas besoin de la feuille intermédiaire :

VB:

Option Explicit

Type ficheNom
    ope As String * 4
    num As String * 13
    ident As String * 34
    dat As String * 15
    P01 As String * 6
    P02 As String * 12
    pointage1 As String * 8
    pointage2 As String * 8
    pointage3 As String * 8
    pointage4 As String * 8
    pointage5 As String * 8
    pointage6 As String * 8
    fin As String * 24
    cr As String * 2
End Type

Sub texte()
    Dim datas
    Dim numfich As Integer, lig As Long, col As Long
    Dim fiche As ficheNom
    With Sheets("DATA")
        datas = .[A2:L2].Resize(.Cells(.Rows.Count, 1).End(xlUp).Row - 1).Value
    End With
    numfich = FreeFile
    Open "D:\tmp\test.txt" For Random As #numfich Len = Len(fiche)
    For lig = 1 To UBound(datas)
        fiche.ope = "1 |"
        fiche.num = Format(datas(lig, 1), "00000")
        fiche.ident = datas(lig, 3) & "," & datas(lig, 2)
        fiche.dat = Format(datas(lig, 4), "dd/mm/yyyy")
        fiche.P01 = Format(datas(lig, 5) / 1440, "hh:mm")
        fiche.P02 = "-" & Format(datas(lig, 6) / 1440, "hh:mm")
        fiche.pointage1 = IIf(datas(lig, 7) = 0, "", Format(datas(lig, 7) / 1440, "hh:mm"))
        fiche.pointage2 = IIf(datas(lig, 8) = 0, "", Format(datas(lig, 8) / 1440, "hh:mm"))
        fiche.pointage3 = IIf(datas(lig, 9) = 0, "", Format(datas(lig, 9) / 1440, "hh:mm"))
        fiche.pointage4 = IIf(datas(lig, 10) = 0, "", Format(datas(lig, 10) / 1440, "hh:mm"))
        fiche.pointage5 = IIf(datas(lig, 11) = 0, "", Format(datas(lig, 11) / 1440, "hh:mm"))
        fiche.pointage6 = IIf(datas(lig, 12) = 0, "", Format(datas(lig, 12) / 1440, "hh:mm"))
        fiche.fin = String(23, " ") & ";"
        fiche.cr = vbCrLf ' modifier si besoin
        Put numfich, lig, fiche ' lig = n° d'enregistrement
    Next lig
    Close #numfich
End Sub

Adapte le répertoire D:\tmp\ et regarde le fichier test.txt généré.
Il ne reste plus qu'à savoir ce qu'est ce que tu appelles 'une ligne vide' pour les éliminer, et peut-être des petites adaptations si j'ai mal compté.
eric

Fred999 · 29 Décembre 2019

Bonjour Eric,

Ton code fonctionne bien mais pour les blancs c'est quand tu crées avec la touche format qu'ils sont créé et je ne peux pas laisser a zéro non plus car l'application qui reçois le fichier texte ne les lis pas et après j'ai appris que les blancs non plus donc je ne dois avoir que des cellules avec des données.
Ci-joint je t'ai mis le fichier texte qui est généré avec ton code et les blanc sont bien là.
C'est clair que ton code est meilleurs que le miens 🙂 mais je ne suis pas un pro VBA comme toi, j'apprend chaque jour et là tu m'as mis une bonne racler🙂
Tu n'as pas une idée pour ses blancs que je voudrais supprimer?
merci pour ton aide,

eriiic · 29 Décembre 2019

Désolé mais je ne vois toujours par de quels blancs tu parles.
Reprend test.txt et précise quelles lignes sont à supprimer.
La dernière, la 55 ? Elle n'est pas blanche, elle est vide et correspond à la fin de la 54.
Sinon dépose test.txt tel qu'il devrait être

Fred999 · 29 Décembre 2019

Ci-joint le fichier j'ai indiqué quelques cellules qui sont vides entre les pointages avec le texte "Blanc" pour que tu vois la différence. Si tu préfère il ne faut pas d'espace entre les pointage.
Normalement il y a 6 pointages pour les ouvriers mais pour les employer il n'y a que 4 pointages et il y a donc un espace qui ce crée et il n'est pas lus par l'application.
Bien à toi,

eriiic · 29 Décembre 2019

Donc on tasse 5 pointages et on laisse le 6ème à sa place ?

A tester :

VB:

Type ficheNom
    ope As String * 4
    num As String * 13
    ident As String * 34
    dat As String * 15
    P01 As String * 6
    P02 As String * 12
    pointages As String * 40
    pointage6 As String * 8
    fin As String * 24
    cr As String * 2
End Type

Sub texte()
    Dim datas
    Dim numfich As Integer, lig As Long, col As Long, s As String
    Dim fiche As ficheNom
    With Sheets("DATA")
        datas = .[A2:L2].Resize(.Cells(.Rows.Count, 1).End(xlUp).Row - 1).Value
    End With
    numfich = FreeFile
    Open "D:\tmp\test.txt" For Random As #numfich Len = Len(fiche)
    For lig = 1 To UBound(datas)
        fiche.ope = "1 |"
        fiche.num = Format(datas(lig, 1), "00000")
        fiche.ident = datas(lig, 3) & "," & datas(lig, 2)
        fiche.dat = Format(datas(lig, 4), "dd/mm/yyyy")
        fiche.P01 = Format(datas(lig, 5) / 1440, "hh:mm")
        fiche.P02 = "-" & Format(datas(lig, 6) / 1440, "hh:mm")
        s = ""
        For col = 7 To 11
            If datas(lig, col) > 0 Then s = s & "   " & Format(datas(lig, col) / 1440, "hh:mm")
        Next col
        fiche.pointages = Mid(s, 4)
        fiche.pointage6 = IIf(datas(lig, 12) = 0, "", Format(datas(lig, 12) / 1440, "hh:mm"))
        fiche.fin = String(23, " ") & ";"
        fiche.cr = vbCrLf ' modifier si besoin
        Put numfich, lig, fiche ' lig = n° d'enregistrement
    Next lig
    Close #numfich
End Sub

Au passage tu peux voir la facilité d'adaptation que permet un type personnalisé.
Pas besoin de recalculer ni modifier les lignes utilisant les éléments inchangés.

Si le 6 est toujours rempli comme j'en ai l'impression, tu enlever le Iif et mettre directement :

Code:

fiche.pointage6 = Format(datas(lig, 12) / 1440, "hh:mm")

Fred999 · 1 Janvier 2020

Bonjour Eric,
D'abord mes meilleurs vœux de bonheur a toi et ta famille pour 2020 🙂
Merci pour le code, j'ai appris pleins de choses c'est nettement mieux que ce que j'avais pondu en 20 pages 🙂
Je t'ai mis le fichier texte car malheureusement les espaces son toujours là entre les pointages et j'ai bien enlevé le Iif sur le pointage 6 car effectivement il y aura toujours un pointage de fin. J'ai essayé de voir ou le souci pouvait ce situé mais franchement sur ton code je suis un peu dépassé c'est Pro quand même 🙂
Si tu as une idée je suis preneur sinon je veux pas t'ennuyer plus avec se problème. Merci encore pour ton aide sincèrement, tu m'as montré que j'ai encore beaucoup à apprendre.

eriiic · 1 Janvier 2020

Bonjour,

Tous mes voeux pour 2020 également, bonheur et santé surtout..
Pour moi c'est conforme à ce que j'ai compris et à ton fichier du post #19.

Donc on tasse 5 pointages et on laisse le 6ème à sa place ?

Maintenant dire ce n'est pas bon sans dire pourquoi précisément ne risque pas de faire avancer beaucoup.
eric

Fred999 · 1 Janvier 2020

Bonsoir Eric,
Je n'ai jamais dit qu'il n’était pas bon, je trouve le code excellent et je ne vais pas critiquer ce que je suis incapable de faire moi-même.
Mais dans le fichier que je met en copie ici, j'ai mis le texte blanc, il faudrait que le pointage 6 (dernier pointage donc de fin de travail) ce déplace
vers la gauche ou j'ai indiqué blanc pour que les pointages se colles. L'application lis en faite le premier pointage de début puis les pauses variables entre 2 ou 4 pointages selon ouvrier ou employer et enfin le pointage de fin. s'il y a un espace entre il pense que c'est un vide et donc sans pointage et il bloque.
C'est ce que je voulais expliquer sur le point 19 mais j'ai peut être été peu clair , désolé. J'espère qu'ici j'ai mis assez d'explication.

eriiic · 1 Janvier 2020

Ben si. A partir du moment où le résultat obtenu n'est pas celui voulu, ce n'est pas bon.
Je ne dis pas que c'est de ma faute non plus ;-)
Question posée il y a 3 jours : "Donc on tasse 5 pointages et on laisse le 6ème à sa place ? ", ce que montrait ton fichier.
Non seulement tu t'expliques mal (on se demande pourquoi tu demandais des suppressions de lignes vides), mais en plus tu ne réponds pas aux questions...

VB:

Option Explicit

Type ficheNom
    ope As String * 4
    num As String * 13
    ident As String * 34
    dat As String * 15
    P01 As String * 6
    P02 As String * 12
    pointages As String * 48
    fin As String * 24
    cr As String * 2
End Type

Sub texte()
    Dim datas
    Dim numfich As Integer, lig As Long, col As Long, s As String
    Dim fiche As ficheNom
    With Sheets("DATA")
        datas = .[A2:L2].Resize(.Cells(.Rows.Count, 1).End(xlUp).Row - 1).Value
    End With
    numfich = FreeFile
    Open "D:\tmp\test.txt" For Random As #numfich Len = Len(fiche)
    For lig = 1 To UBound(datas)
        fiche.ope = "1 |"
        fiche.num = Format(datas(lig, 1), "00000")
        fiche.ident = datas(lig, 3) & "," & datas(lig, 2)
        fiche.dat = Format(datas(lig, 4), "dd/mm/yyyy")
        fiche.P01 = Format(datas(lig, 5) / 1440, "hh:mm")
        fiche.P02 = "-" & Format(datas(lig, 6) / 1440, "hh:mm")
        s = ""
        For col = 7 To 12
            If datas(lig, col) > 0 Then s = s & "   " & Format(datas(lig, col) / 1440, "hh:mm")
        Next col
        fiche.pointages = Mid(s, 4)
        fiche.fin = String(23, " ") & ";"
        fiche.cr = vbCrLf ' modifier si besoin
        Put numfich, lig, fiche ' lig = n° d'enregistrement
    Next lig
    Close #numfich
End Sub

Si ce n'est pas ça, met le fichier texte exactement comme il doit être. qu'on en finisse une bonne fois pour toute.
eric

Fred999 · 2 Janvier 2020

Bonsoir Eric,

Merci beaucoup pour le code ça marche parfaitement, tu es un génie, un peu colérique mais comme tout les génies 🙂

Je ferais une statue en ton nom pour ton aide 🙂 et j'ai appris pas mal de chose.

Bon en 2020 il faut plus que tu n’énerve comme cela ou tu vas faire une crise cardiaque avant l'âge, donc reste cool 😉

Désolé, si je n'ai pas été clair dans mes demandes ce n'est pas toujours évident d’expliquer par écrit.

Un grand merci à toi et bonne continuation.

Fred999 · 2 Janvier 2020

Heu "que tu t’énerve" je voulais dire hahahaaaaaaaaaa!!!!!!!!!

eriiic · 2 Janvier 2020

Bonjour,

Ah non, là tu ne m'as pas vu énervé.
C'est juste que je ne m'épuise pas en salamalecs lorsqu'il s'agit de mettre les points sur les i ;-)
J'aime quand on va droit au but...
Bonne continuation.
eric

Microsoft 365 Effacer ligne sans date fichier texte via VBA excel

Fred999

XLDnaute Nouveau

eriiic

XLDnaute Barbatruc

Fred999

XLDnaute Nouveau

Pièces jointes

eriiic

XLDnaute Barbatruc

Fred999

XLDnaute Nouveau

Pièces jointes

eriiic

XLDnaute Barbatruc

Fred999

XLDnaute Nouveau

Pièces jointes

eriiic

XLDnaute Barbatruc

Fred999

XLDnaute Nouveau

Pièces jointes

eriiic

XLDnaute Barbatruc

Fred999

XLDnaute Nouveau

Fred999

XLDnaute Nouveau

eriiic

XLDnaute Barbatruc

Discussions similaires

Microsoft 365 Effacer ligne sans date fichier texte via VBA excel

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Nouveau

Pièces jointes

XLDnaute Barbatruc

XLDnaute Nouveau

Pièces jointes

XLDnaute Barbatruc

XLDnaute Nouveau

Pièces jointes

XLDnaute Barbatruc

XLDnaute Nouveau

Pièces jointes

XLDnaute Barbatruc

XLDnaute Nouveau

XLDnaute Nouveau

XLDnaute Barbatruc

Discussions similaires

Privacy & Transparency

Privacy & Transparency