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
| Option Explicit
' Si la langue de l'OS est l'anglais, on doit remplacer "Feuil1" par "Sheet1" à la ligne 27.
Const ForReading = 1
Const ForWriting = 2
Const FichExcel = "C:\Repertoire\Correspond.xls"
Dim oFso, objFile, strLine, arrLines, NewText
Dim I, oFile, xlTemp, Contenu
Dim temp, oXL, oSheet, oBook
ProcessFile
DelEmptyLine
'===========================
Sub ProcessFile()
Set oFso = CreateObject("Scripting.FileSystemObject")
Set oXL = CreateObject("Excel.Application")
Set oBook = oXL.Workbooks.Open(FichExcel)
oXL.Visible = False
Set oFso = CreateObject("Scripting.FileSystemObject")
Set objFile = oFso.OpenTextFile("C:\Repertoire\TEST.txt", ForReading)
Set oFile = oFso.OpenTextFile("C:\Repertoire\RESULTEST.txt", ForWriting, True)
I = 1 ' Ici on doit mettre le numéro correct de la ligne de début du fichier excel
While Not objFile.AtEndOfStream
strLine = objFile.ReadLine
If strLine <> "" Then
oFile.WriteLine strLine ' On écrit la ligne telle qu'elle est
temp = Mid(strLine, 7) ' On supprime les 6 premiers caractères de la ligne lue
' on récupère le code à 6 caractères
xlTemp = Rechercher_Correspondance(Left(strLine,6),oBook.Worksheets("Feuil1").Cells(I, 1))
oFile.WriteLine xlTemp & temp ' on écrit une autre ligne avec le code au début
I = I + 1 ' on incrémente le numéro de la ligne dans le fichier excel .
End If
Wend
oFile.Close
objFile.Close
oXL.Quit
End Sub
'===============================
Function Rechercher_Correspondance(strValueFromSource,strFromCorrespond)
Dim Ret
I = 1
Do While strFromCorrespond <> "" ' tant qu'une ligne contienne des données
strFromCorrespond = oBook.Worksheets("Feuil1").Cells(I, 1) ' ligne n°I de la colonne 1
If strFromCorrespond = strValueFromSource Then ' si OK on récupère la valeur
Ret = oBook.Worksheets("Feuil1").Cells(I, 2) ' valeur de la colonne 2 correspondant
' au code de 6 caractères de la colonne 1. Puis on sort de la boucle
Exit Do
End If
I = I + 1 ' On passe à la ligne suivante si pas trouvé
Loop
Rechercher_Correspondance = Ret
End Function
'=====================
Sub DelEmptyLine() ' On supprime la dernière ligne vide
Dim oFso
NewText = ""
Set oFso = CreateObject("Scripting.FileSystemObject")
Set oFile = oFso.OpenTextFile("C:\Repertoire\RESULTEST.txt", ForReading, False)
Contenu = oFile.ReadAll
oFile.Close
Set oFile = oFso.OpenTextFile("C:\Repertoire\RESULTEST.txt", ForWriting, True)
arrLines = Split(Contenu, vbCrLf)
For i = 0 To UBound(arrLines) - 2
NewText = NewText & arrLines(i) & vbCrLf
Next
NewText = NewText & arrLines(UBound(arrLines)-1)
oFile.Write NewText
oFile.Close
Set oFile = Nothing
Set oFso = Nothing
End Sub |
Ne pas oublier le tag 
si satisfait.
Voter pour toute réponse satisfaisante avec 
pour encourager les intervenants.
Répondre avec citation
Envoyé par YLKweb
je ne connais n'y ne pratique Excel.
Partager