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 |
