Discussion :

[laliemendez]

Bonjour à tous

Je cherche à importer un CSV dans un onglet.
Chaque "colonne" est encadré par des guillemets " ... " Le séparateur est le point-virgule ;

Seulement, il arrive que les champs Adresse ou Description ait un saut de ligne, ce qui créé une fausse nouvelle ligne
Je cherche à retraiter le fichier pour les remplacer par un espace afin de n'avoir que des lignes complètes

Y a-t-il moyen de l'indiquer lors de l'import du fichier ?

Voici une image du fichier de base (avec les points bleus sur les "fausses" lignes)
midfirst near me

Voici mon code pour l'import du CSV

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
    'Import du CSV
    xFileName = Application.GetOpenFilename("CSV File (*.csv), *.csv", , "Import fichier CSV", , False)
    If xFileName = False Then Exit Sub
    With ActiveSheet.QueryTables.Add("TEXT;" & xFileName, Range("A1"))
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 936
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileOtherDelimiter = ";"
        .TextFileSpaceDelimiter = False
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With

Merci d'avance

[Mickamax]

Bonjour,
Petite suggestion: pourquoi ne pas ajouter une boucle à la fin de ton code dans laquelle tu supprimerais les lignes dont la première cellule est vide (par exemple) ? Ce sera probablement plus lourd que la solution que tu préconises mais aussi beaucoup plus simple à coder (et donc à modifier si problème à venir).

Mickamax

[laliemendez]

Lors de l'import, Excel considère que c'est une nouvelle ligne ==> la première cellule est donc non vide

[Phiphi41]

Bonjour

Une idée comme une autre

1. Ne pas utiliser le code que tu as
2. Lire le fichier ligne par ligne
3. Quand tu es sur une ligne tu mets toute ta ligne dans une variable de type texte.
4. Dans cette variable tu fais un remplacement Chr(13) ou Chr(10) par un blanc
5. Tu split ta ligne dans une variable tableau avec le ; comme séparateur
6. Tu parcours ce tableau pour remplir la feuille

C'est une idéé, mais que j'utilise souvent (dans d'autres circonstances) lorsque le fichier ne répond pas aux normes du vrai csv.

[Mickamax]

Re-bonjour,
La "première cellule" était un exemple. Dans la capture d'écran que tu fournis, il me semble que certaines informations sont renseignées obligatoirement. C'est le cas notamment de ton code postal.

Tu pourrais donc adapter un code par rapport à cette colonne:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Dligne=range("G90000").end(xlup).row
 
For I= 2 to Dligne
 
If cells(I,7)="" then rows(I).delete
 
 
Next I

J'ai rédigé ça comme ça, à adapter évidemment.

[laliemendez]

@Phiphi41 : si je n'arrive pas à trouver de solution, j’essayerai de partir là-dessus. Le problème est que je n'ai aucun début de code pour pouvoir lire un fichier ligne à ligne Mais je pense que ça doit pouvoir se trouver

@Mickamax : Je ne veux pas les supprimer La nouvelle ligne contient des infos utiles. Elle a juste été tronqué par ce put** de retour à la ligne
Ici j'ai volontairement supprimer les champs suivants qui contiennent des infos à reprendre aussi. De plus, hasard du choix des lignes dans les milliers disponibles, le code postal n'est pas tout le temps renseigné.

[Thumb down]

Bonsoir,
Le caractère de retour chariot est chr(10) le caractère de fin de ligne est chr(13) et il est toujours précédé de chr(10) !

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Replace(Replace(Replace(txt,vbcrlf,"®"),chr(10),"©"),"®",vbcrlf)

Quand tu auras importé dans Excel, tu pourras remplacer les © par des chr(10).

[patricktoulon]

salut
déjà chez moi avec blocknote il n'y a pas de saut de ligne du tout
on peut tout le reformater si tu veux
voir directement créer une variable tableau avec les données indentées dedans

[laliemendez]

Effectivement, tous les caractères de fin de ligne sont identiques sous Notepad++ ==> pas moyen de les filtrer comme ca


L'idéal est d'avoir le retraitement lors de l'insertion dans l'onglet car j'en ait plusieurs à faire. Je veux éviter de retraiter les fichiers en amont et de pouvoir mettre le traitement dans la macro.

Seulement je ne vois pas comment commencer pour "réassembler" les lignes

[patricktoulon]

re
ben moi je vois comment il faut faire
on reformate tout le texte sans vbcrlf,chr(10),chr(13)
on le coupe apres "website" pour connaitre le nombre de colonne dans le header
et enfin on coupe le texte complet par les lincks
et chaque ligne est splittée et transférées sur le sheets

comme ca vite fait

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
 
Sub readCsvBizarre()    ' recupe le texte complet  avec binary acces read
    Dim laChaine As String, x, fichier As String, l_array, entete, i&
    fichier = "C:\Users\polux\DeskTop\Lalie_Fichier_Exemple.csv"
    x = FreeFile
    Open fichier For Binary Access Read As #x: laChaine = String(LOF(x), " "): Get #x, , laChaine
    Close #x
    laChaine = Replace(Replace(Replace(Replace(laChaine, Chr(34), ""), vbCrLf, ""), Chr(10), ""), Chr(13), "")
    l_array = Split(laChaine, ";")
    laChaine = Replace(laChaine, "Website;", "Website;" & vbCrLf)
    For Each elem In l_array
        If InStr(elem, "http://") > 0 Or InStr(elem, "https://") > 0 Then
            laChaine = Replace(laChaine, elem & ";", elem & ";" & vbCrLf)
        End If
    Next
    laChaine = Replace(laChaine, vbCrLf & vbCrLf, vbCrLf)
    laChaine = Replace(laChaine, vbCrLf & vbCrLf, vbCrLf)
    'maintenant les lignes sont corectes elles terminent toutes par le linck
    'on choppe le header  de colonne
    l_array = Split(laChaine, vbCrLf)
    entete = Split(l_array(0), ";")    'le header des colonnes
    For i = LBound(l_array) To UBound(l_array)
        If l_array(i) <> ";" Then Cells(i + 1, 1).Resize(1, UBound(entete)) = Split(l_array(i), ";")
    Next
    'Debug.Print laChaine
End Sub

résultat

[Thumb down]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
Public Property Let PressePapier(Value)
Const DATAOBJECT_BINDING As String = "new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}"
    With CreateObject(DATAOBJECT_BINDING)
        .SetText Value
        .PutInClipboard
    End With
End Property
Public Property Get PressePapier()
Const DATAOBJECT_BINDING As String = "new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}"
    With CreateObject(DATAOBJECT_BINDING)
        .GetFromClipboard
        PressePapier = .GetText
    End With
End Property
Sub test()
fichier = "C:\MyRep\Lalie_Fichier_Exemple.csv"
Open fichier For Input As #1
 PressePapier = Replace(Replace(Decode_UTF8(Input(LOF(1), #1)), ";", vbTab), Chr(10) & Chr(10), Chr(10))
 Sheets(1).Range("A1").PasteSpecial xlPasteAll
 Close #1
End Sub
Public Function isUTF8(astr)
    Dim c0, c1, c2, c3
    Dim n
 
    isUTF8 = True
    n = 1
    Do While n <= Len(astr)
        c0 = Asc(Mid(astr, n, 1))
        If n <= Len(astr) - 1 Then
            c1 = Asc(Mid(astr, n + 1, 1))
        Else
            c1 = 0
        End If
        If n <= Len(astr) - 2 Then
            c2 = Asc(Mid(astr, n + 2, 1))
        Else
            c2 = 0
        End If
        If n <= Len(astr) - 3 Then
            c3 = Asc(Mid(astr, n + 3, 1))
        Else
            c3 = 0
        End If
 
        If (c0 And 240) = 240 Then
            If (c1 And 128) = 128 And (c2 And 128) = 128 And (c3 And 128) = 128 Then
                n = n + 4
            Else
                isUTF8 = False
                Exit Function
            End If
        ElseIf (c0 And 224) = 224 Then
            If (c1 And 128) = 128 And (c2 And 128) = 128 Then
                n = n + 3
            Else
                isUTF8 = False
                Exit Function
            End If
        ElseIf (c0 And 192) = 192 Then
            If (c1 And 128) = 128 Then
                n = n + 2
            Else
                isUTF8 = False
                Exit Function
            End If
        ElseIf (c0 And 128) = 0 Then
            n = n + 1
        Else
            isUTF8 = False
            Exit Function
        End If
    Loop
End Function
 
 
Public Function Encode_UTF8(astr)
    Dim c
    Dim n
    Dim utftext
 
    utftext = ""
    n = 1
    Do While n <= Len(astr)
        c = AscW(Mid(astr, n, 1))
        If c < 128 Then
            utftext = utftext + Chr(c)
        ElseIf ((c >= 128) And (c < 2048)) Then
            utftext = utftext + Chr(((c \ 64) Or 192))
            utftext = utftext + Chr(((c And 63) Or 128))
        ElseIf ((c >= 2048) And (c < 65536)) Then
            utftext = utftext + Chr(((c \ 4096) Or 224))
            utftext = utftext + Chr((((c \ 64) And 63) Or 128))
            utftext = utftext + Chr(((c And 63) Or 128))
        Else ' c >= 65536
            utftext = utftext + Chr(((c \ 262144) Or 240))
            utftext = utftext + Chr(((((c \ 4096) And 63)) Or 128))
            utftext = utftext + Chr((((c \ 64) And 63) Or 128))
            utftext = utftext + Chr(((c And 63) Or 128))
        End If
        n = n + 1
    Loop
    Encode_UTF8 = utftext
End Function
Public Function Decode_UTF8(astr)
    Dim c0, c1, c2, c3
    Dim n
    Dim unitext
 
 
    If isUTF8(astr) = False Then
        Decode_UTF8 = astr
        Exit Function
    End If
 
 
    unitext = ""
    n = 1
    Do While n <= Len(astr)
        c0 = Asc(Mid(astr, n, 1))
        If n <= Len(astr) - 1 Then
            c1 = Asc(Mid(astr, n + 1, 1))
        Else
            c1 = 0
        End If
        If n <= Len(astr) - 2 Then
            c2 = Asc(Mid(astr, n + 2, 1))
        Else
            c2 = 0
        End If
        If n <= Len(astr) - 3 Then
            c3 = Asc(Mid(astr, n + 3, 1))
        Else
            c3 = 0
        End If
 
 
        If (c0 And 240) = 240 And (c1 And 128) = 128 And (c2 And 128) = 128 And (c3 And 128) = 128 Then
            unitext = unitext + ChrW((c0 - 240) * 65536 + (c1 - 128) * 4096) + (c2 - 128) * 64 + (c3 - 128)
            n = n + 4
        ElseIf (c0 And 224) = 224 And (c1 And 128) = 128 And (c2 And 128) = 128 Then
            unitext = unitext + ChrW((c0 - 224) * 4096 + (c1 - 128) * 64 + (c2 - 128))
            n = n + 3
        ElseIf (c0 And 192) = 192 And (c1 And 128) = 128 Then
            unitext = unitext + ChrW((c0 - 192) * 64 + (c1 - 128))
            n = n + 2
        ElseIf (c0 And 128) = 128 Then
            unitext = unitext + ChrW(c0 And 127)
            n = n + 1
        Else ' c0 < 128
            unitext = unitext + ChrW(c0)
            n = n + 1
        End If
    Loop
 
 
    Decode_UTF8 = unitext
End Function

[laliemendez]

Oufff ca marche !

Petite question, je dois importer plusieurs fichiers avec des en-têtes différentes (nombre et nom de colonne). Précision : il y a toujours une ligne d'entête (avec ou sans une ligne vide avant)

Comment puis-je calculer, sur la ligne d'entête, la dernière colonne ? pour pouvoir remplacer "Website" par la dernière colonne

Sachant qu"on n'est pas encore dans Excel (donc loin des Range et autre), j'ai un peu de mal à savoir ou chercher

[patricktoulon]

Oufff ca marche !

Petite question, je dois importer plusieurs fichiers avec des en-têtes différentes (nombre et nom de colonne). Précision : il y a toujours une ligne d'entête (avec ou sans une ligne vide avant)

Comment puis-je calculer, sur la ligne d'entête, la dernière colonne ? pour pouvoir remplacer "Website" par la dernière colonne

Sachant qu"on n'est pas encore dans Excel (donc loin des Range et autre), j'ai un peu de mal à savoir ou chercher

re
non c'est l'inverse
on calcule pas pour remplacer "website" ;on choppe "website" pour calculer le nombre de colonne


tu n'a qu'a remplacer le mots "website" sur cette ligne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

laChaine = Replace(laChaine, "Website;", "Website;" & vbCrLf)

et remplacer l'expression dans le test instr

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

If InStr(elem, "http://") > 0 Or InStr(elem, "https://") > 0 Then

le reste mon code s'en charge

attention a la structure du texte cela est valable a partir du moment ou les lignes arrangées on le meme nombres de colonne que le header sinon il faudra ajouter une gestion du count dans une condition "if"

si tu connais pas les mots a l'avance il te faudra faire un tout petit interface avec une listebox allant chercher les mots

[patricktoulon]

re
je t'ai fait un petit outils comme ca vite fait pour m'amuser


la démo parle d'elle même

bon il te restera quelque variable a déclarer
normalement ca devrait fonctionner sur tout tes csv mal fagottés

[laliemendez]

Merci patricktoulon

Pas besoin de forms spécifique, tout peut se faire via le code sans IHM
J'ai plusieurs fichiers à traiter dans le même cas. Je peux passer en paramètre le nom de la dernière colonne. Je le connais toujours selon le type de fichier


Par contre, l'expression texte est plus compliqué car elle varie selon la dernière colonne (date, champ texte, id, ...)
A la limite, je peux remettre l'ID de l'objet en fin de ligne.
Il est du style xxxxxxxx-xxxx-xxxx-xxxxxxxxxxxx

Il faut donc
- soit que la macro "comprenne" que le nom (ou le numéro) de colonne passé en paramètre fixe le nombre de colonne (séparé par , ou
- soit lui passer la "forme" de l'id pour qu'il se base dessus

[laliemendez]

Vu que personne ne me répond je change mon fusil d'épaule et reformule ma demande différemment

Voila comment je l'imagine :

1. Importer le texte sans séparateur (ici j'ai triché avec le séparateur µ) ==> j'ai déjà mon code
2. Compter le nombre de séparateur ; sur chaque ligne ==> Je vais trouver je pense
3. Si le nombre en paramètre n'est pas atteint (en les taggant dans un tableau par exemple), alors je "concatène" avec la ligne suivante et je recommence mon calcul sur cette ligne (si plusieurs retour à la ligne)) ==> c'est là que je vais avoir besoin de vous

Comment peut-on rajouter la ligne à celle du haut pour refaire une ligne complète ?

Voici mon code pour la partie 1 :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
    NomOnglet = "Lalie_Exemple_Account"
    IndicationChemin = "[...]\OneDrive\Reports_CSV"
 
    'Partie 1 : Import du CSV
    xFileName = Application.GetOpenFilename("CSV File (*.csv), *.csv", , "Import fichier <" & NomOnglet & "> depuis " & IndicationChemin, , False)
    If xFileName = False Then Exit Sub
    With ActiveSheet.QueryTables.Add("TEXT;" & xFileName, Range("A1"))
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 936
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
        ' Je "triche" avec le séparateur µ pour obtenir les lignes entiéres et ensuite les retraite
        .TextFileCommaDelimiter = False
        .TextFileOtherDelimiter = "µ"
 
        ' Partie 2 RAF : compter les ; pour identifier les lignes "orphelines
 
        ' Partie 3 RAF : Réunir les lignes "orphelines". Pensez aux lignes avec plusieurs retours à la ligne

Voici des images des différents fichiers qui peuvent être en entrée (dispo en PJ)

Account


Contact

Si personne ne répond car fil trop vieux, je le clôturerai et ouvrirai un nouveau avec cette question bien plus précise

[patricktoulon]

re
bonjour
je t'ai fait un outils pour re masteuriser tes csvs avant de les travailler
tu veux quoi de plus

d'autant plus que dans ta capture n°2 il y aura au moins une ligne avec plus de colonne que le header ET CA avec vba tu n'y pourra rien !!!!
j'ai vérifié

et en plus tes 2 fichiers dans le zip c'est le même texte dedans
tu devrais reposer et revenir dessus après avoir dé saturé

dans tout les cas une importation tel quel sur exel puis travailler dessus le range tu peux OUBLIER!!!!

[laliemendez]

Bonjour patricktoulon

J'ai vérifié consciencieusement et

Mes 2 fichiers dans le zip sont bien différents. J'ai vérifié en téléchargeant le fichier et en les extrayant.
On a bien "Lalie_Exemple_Account.csv" (qui est une légére modif de mon 1° fichier en début de conservation) et "Lalie_Exemple_Contact.csv"
J'ai plusieurs fichiers à importer, je voulais donc faire du code générique en passant des paramètres pour les typologies différentes




De plus, ta form ne fonctionne pas chez moi J'ai voulu refaire selon ton GIF et ca ne marche pas
1) Je sélectionne le fichier
2) Je surligne la dernière colonne

3) Je click sur "Next Expression" et le fichier n'est pas formaté correctement

[patricktoulon]

bon comme je vois que tu comprends pas
je te le dis en terme clair
j'ai ouvert ton fichier avec block note un des tes 3 exemple

il n'ont pas le même nombre de colonnes sur toutes les lignes
les données ne correspondent pas toujours au theme du header
exemple dans cette capture
la première croix rouge si je ne trompe pas il y a 8 colonne au lieu de 7 comme le header

la 2d un vrai fouilli ou il y a tel c'est que le tel est non seulement pas a la bonne colonne mais je crois bien qu'il est mélangé a d'autre données
la preuve sur cette capture


et c'est pas le pire de tes fichiers


parti de la je suis catégorique ;il te sera impossible d'automatiser l'extraction en bon et due forme



même a la main dans bloknote je saurais même pas le mettre en ordre tellement c'est incohérent

il ne te reste plus qu'a t'armer de patience et le faire a la main selon ta vision du résultat qui doit être

tu peux renouveler le message et faire des UP autant que tu veux, tu aura la même réponse au regard de tes fichiers en exemple

après tu comprends pas ben continue

perso je te laisse la ,pour moi l'automatisation sur ce genre de fichier est impossible

[laliemendez]

J'ai bien compris que je ne pouvais pas automatiser mes fichiers

Je veux seulement comprendre où est l'erreur sur le nombre de colonne de la ligne avec ta croix rouge


Effectivement, le champ "description" de l'autre ligne est rempli avec plein de trucs. La joie d'avoir des gens qui ne se préoccupent pas des conséquences

Merci d'avoir tenté de m'aider