[VBA-E]Problème de caractères spéciaux

**Jusomi31** · 06/06/2007, 14h15

Bonjour,
J' ai un fichier texte que je veux importer dans Excel.

Ce fichier texte est créé automatiquement par extraction de données dans une base de donnée externe à mon entreprise.

J'ai presque résolu mon problème : dans mon fichier texte je dois supprimmer tous les caractères de retour à la ligne, saut de ligne, retour charriot, tabulation, etc...

Car à cause de ces caractères, Mes données ne sont pas calées correctement dans mon fichier Excel. Voir même il n'importe pas toutes les donnéessi il tombe sur certains caractères comme tabulation.

Si je me retrouvais avec toutes mes données les unes à la suite des autres , l'importation se ferai sans problème.

Voici le code de la fonction que j'ai créé et qui me supprime quelque uns de caractères spéciaux cités ci-dessus :

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
Sub ReplaceTextInFile(SourceFile As String, _
    sText As String, rText As String)
Dim TargetFile As String, tLine As String, tString As String
Dim p As Integer, i As Long, F1 As Integer, F2 As Integer
    TargetFile = "RESULT.TMP"
    If Dir(SourceFile) = "" Then Exit Sub
    If Dir(TargetFile) <> "" Then
        On Error Resume Next
        Kill TargetFile
        On Error GoTo 0
        If Dir(TargetFile) <> "" Then
            MsgBox TargetFile & _
                " already open, close and delete / rename the file and try again.", _
                vbCritical
            Exit Sub
        End If
    End If
    F1 = FreeFile
    Open SourceFile For Input As F1
    F2 = FreeFile
    Open TargetFile For Output As F2
    i = 1 ' line counter
    Application.StatusBar = "Reading data from " & _
        TargetFile & " ..."
    While Not EOF(F1)
        If i Mod 100 = 0 Then Application.StatusBar = _
            "Reading line #" & i & " in " & _
            TargetFile & " ..."
        Line Input #F1, tLine
        If tLine <> "" Then
            If tLine <> " " Then
                ReplaceTextInString tLine, sText, rText
                Print #F2, tLine
            End If
        End If
 
 
        i = i + 1
    Wend
    MsgBox i
    Application.StatusBar = "Closing files ..."
    Close F1
    Close F2
    Kill SourceFile ' delete original file
    Name TargetFile As SourceFile ' rename temporary file
    Application.StatusBar = False
End Sub
 
Sub ReplaceTextInString(SourceString As String, _
    SearchString As String, ReplaceString As String)
Dim p As Integer, NewString As String
    Do
        p = InStr(p + 1, UCase(SourceString), UCase(SearchString))
        If p > 0 Then ' replace SearchString with ReplaceString
            NewString = ""
            If p > 1 Then NewString = Mid(SourceString, 1, p - 1)
            NewString = NewString + ReplaceString
            NewString = NewString + Mid(SourceString, _
                p + Len(SearchString), Len(SourceString))
            p = p + Len(ReplaceString) - 1
            SourceString = NewString
        End If
        If p >= Len(NewString) Then p = 0
    Loop Until p = 0
End Sub
 
 
 
Sub TestReplaceTextInFile()
    'text file must be in the same path than excel document
 
    'ReplaceTextInFile ThisWorkbook.Path & _
        "\data.txt", " ", ""
    ReplaceTextInFile ThisWorkbook.Path & _
        "\data.txt", "  ", ""
End Sub

Est-ce que par hasard quelqu'un saurait comment optimiser ce code pour qu'il me supprime tous les caractères spéciaux que j'ai cités ???

J'espère que quelqu'un pourra m'aider car ça fait un moment que je bloque là-dessus...

Merci d'avance !

**Jusomi31** · 06/06/2007, 14h59

C'est bon j'ai la solution !!!
Merci...

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
Sub ReplaceTextInFile(SourceFile As String, _
    sText As String, rText As String)
Dim TargetFile As String, tLine As String, tString As String, ch As String
Dim p As Integer, i As Long, F1 As Integer, F2 As Integer, cpt As Integer
    TargetFile = "RESULT.TMP"
    If Dir(SourceFile) = "" Then Exit Sub
    If Dir(TargetFile) <> "" Then
        On Error Resume Next
        Kill TargetFile
        On Error GoTo 0
        If Dir(TargetFile) <> "" Then
            MsgBox TargetFile & _
                " already open, close and delete / rename the file and try again.", _
                vbCritical
            Exit Sub
        End If
    End If
    F1 = FreeFile
    Open SourceFile For Input As F1
    F2 = FreeFile
    Open TargetFile For Output As F2
    i = 1 ' line counter
    Application.StatusBar = "Reading data from " & _
        TargetFile & " ..."
    While Not EOF(F1)
        If i Mod 100 = 0 Then Application.StatusBar = _
            "Reading line #" & i & " in " & _
            TargetFile & " ..."
        Line Input #F1, tLine
        If tLine <> "" Then
            If tLine <> " " Then
                ReplaceTextInString tLine, sText, rText
                cpt = cpt + OccurenceCount(tLine, "^")
                ch = ch + tLine
                If cpt >= 10 Then
                    Print #F2, ch
                    cpt = 0
                    ch = ""
                End If
            End If
        End If
        i = i + 1
    Wend
    MsgBox i
    Application.StatusBar = "Closing files ..."
    Close F1
    Close F2
    Kill SourceFile ' delete original file
    Name TargetFile As SourceFile ' rename temporary file
    Application.StatusBar = False
End Sub
 
Private Sub ReplaceTextInString(SourceString As String, _
    SearchString As String, ReplaceString As String)
Dim p As Integer, NewString As String
    Do
        p = InStr(p + 1, UCase(SourceString), UCase(SearchString))
        If p > 0 Then ' replace SearchString with ReplaceString
            NewString = ""
            If p > 1 Then NewString = Mid(SourceString, 1, p - 1)
            NewString = NewString + ReplaceString
            NewString = NewString + Mid(SourceString, _
                p + Len(SearchString), Len(SourceString))
            p = p + Len(ReplaceString) - 1
            SourceString = NewString
        End If
        If p >= Len(NewString) Then p = 0
    Loop Until p = 0
End Sub
Function OccurenceCount(SourceString As String, SearchString As String) As Integer
 
Dim p As Integer ', NewString As String
OccurenceCount = 0
p = Len(SourceString)
Do
    'MsgBox Mid(SourceString, p, 1)
    If Mid(SourceString, p, 1) = SearchString Then
        OccurenceCount = OccurenceCount + 1
    End If
    p = p - 1
Loop Until p = 0
 
End Function
 
Sub TestReplaceTextInFile()
    'text file must be in the same path than excel document
 
    'InsertTextInFile ThisWorkbook.PATH & _
        "\data.txt", "john"
 
    ReplaceTextInFile ThisWorkbook.Path & _
        "\data.txt", "  ", ""
    'ReplaceTextInFile ThisWorkbook.PATH & _
        "\data.txt", "\r", "#"
    'ReplaceTextInFile ThisWorkbook.PATH & _
        "\data.txt", "\t", "#"
    ' replaces all pipe-characters (|) with semicolons (;)
 
    ' deux idées
    ' tous les 10 ^ on passe a la ligne en inserant la ligne créée
End Sub

[VBA-E]Problème de caractères spéciaux

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager