Codage de macro

Version imprimable

Codage de macro

Bonjour à tous,

J'ai utilisé google & la fonction recherche en vain ...

Je cherche à réaliser une macro qui me permette de modifier du texte dans mon fichier.

Voici un extrait de mon fichier :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 #31000EQ=#ST3010T+#ST4010T+#ST1110T+#ST1120T+#ST1130T+#ST1140T+#ST1210T+ #ST1220T+#ST1230T+#ST1240T+#ST1150T+#ST1250T #31000EQST=#ST1300T #31000AT=NOINP #31000FO=NOINP #31000MS=#ST2210T+#ST2011T+#ST2012T+#ST2031T+#ST2032T+#ST2130T+#ST2036T+ & #ST2037T+#ST2050T+#ST2120T+#ST2110T+#ST2055T+#ST2021T+#ST2022T+#ST2040T+ & #ST2092T+#ST2093T+#ST2013T+#ST2023T+#ST2033T+#ST2038T+#ST2096T #31000MSST=#ST2026T+#ST2027T+#ST2094T+#ST2095T+#ST2028T+#ST2097T #31000NE=#SN1000T+#SN1010T+#SN1011T+#SN1015T+#SN1016T+#SN1020T+#SN2010T+ & #SN3010T+#SN4010T+#SN4020T+#SR1010T+#SR1011T+#SR1020T+#SR1021T+#SR4010T+ & #SR4020T #31000NEST=NOINP
Ainsi, à chaque fois que je trouve un " & " en fin de ligne, je veux que la ligne du dessous sois concaténé à celle ou a été trouve le "&" et ainsi de suite.
Il faut savoir qu'à chaque fois mes données ne sont que dans 1 colonnes. C'est pour moi une manière de traiter mon fichier pour ensuite pouvoir l'intégrer à un autre outils.

Finalement, ça revient à quelque chose d'apriori pas trop complexe ... Il faudrait une fonction récursive mais là est mon soucis.. Je n'arrive pas à bien la faire.

De plus, je ne connais pas les propriétés propres au VBA Excel.

Voici ce que serait à faire dans mon idée mais que je n'arrive pas bien à faire ..

J'édite mon message lorsque j'arriverai à bien modéliser le code que je souhaite faire car je bug un peu ...

Merci d'avance,

03/03/2011, 15h56
el_slapper

plusieurs pistes sur le fil suivant : discussion pour faire disparaitre des retours chariots

Le problème est presque similaire au tien, et les 3 méthodes proposées fonctionnent(même la mienne, qui n'est sans doute pas la meilleure).

J'ai donc tenté d'avancé un peu, surement quelques erreurs mais voilà le principe ..

Code:

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
Sub modif_mapping()
 
    Dim i, nblignes, premier As Integer
 
    'On compte le nombre de lignes
    nblignes = Range("A6").End(xlDown).Row
 
    'Tant que i<nblignes, on parcours les lignes et on vérifis certaisn choses
    While (i < nblignes)
        'On met la chaine à vide
        chaine = ""
        premier = i
        'On appel la fonction récursive "contient" avec la ligne courante
        i = contient(chaine, i)
        Range("A" & premier).Value = Range("A" & premier).Value + chaine
    Wend
End Sub
'Cette fonction aura pour objectif de renvoyer un entier qui sera le nouveau point de départ pour le parcour et de modifier la chaine
'qui sera ajoutée à la 1ère ligne contenant &
Function contient(ByRef chaine, ByVal i)
 
    If (Range("A" & i).Value Like "*&") Then
        chaine = chaine + Range("A" & i).Value
        contient(chaine,i)
        i = i + 1
    End If
 
    return i+1
 
End Function

@El_slapper,

Merci mais je ne comprend pas bien ton code ...

Code:

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
Option Explicit
 
Sub EradicationRetourChariot()
    Dim NumFich1 As Integer, NumFich2 As Integer
    Dim NomFich1 As String, Nomfich2 As String
    Dim Pos1 As Long, Pos2 As Long, Val1 As Integer
    Dim CaractereLu As String * 1
 
    NumFich1 = FreeFile
    NomFich1 = "Z:\export.txt"
    Open NomFich1 For Random As #NumFich1 Len = 1
 
    NumFich2 = FreeFile
    Nomfich2 = "Z:\export2.txt"
    Open Nomfich2 For Random As #NumFich2 Len = 1
 
    Pos1 = 0
    Pos2 = 0
    Do While Not EOF(NumFich1)
        Pos1 = Pos1 + 1
        Get #NumFich1, Pos1, CaractereLu
        Val1 = Asc(CaractereLu)
        If (Val1 <> 10) And (Val1 <> 13) Then
            Pos2 = Pos2 + 1
            Put #2, Pos2, CaractereLu
        End If
    Loop
    Close #NumFich1
    Close #NumFich2
End Sub

Je n'ai qu'un fichier mapping.txt,

Pourquoi en prendre 2 ... ? Je ne comprend pas bien les If (Val1 <> 10) And (Val1 <> 13)

merci d'avance,

Bon bah j'ai réussi de la manière qui suit :

Code:

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
Sub modif_mapping()
 
Call supprimer_noinp
Call concatener
Call supprimer_noinp
Call concatener
Call supprimer_noinp
Call concatener
Call supprimer_noinp
Call concatener
Call supprimer_noinp
Call concatener
Call supprimer_noinp
Call concatener
 
 
 
End Sub
 
Function supprimer_noinp()
    Dim nblignes As Integer
    Dim i As Integer
 
    'On compte le nombre de lignes
    nblignes = Range("A6").End(xlDown).Row
 
    i = 1
 
    'Tant que i<nblignes, on parcours les lignes et on vérifis certaisn choses
    While (i < nblignes)
 
        'On met la chaine à vide
        ra = "A" & i
        ra2 = "A" & i + 1
 
        If (Range(ra).Value Like "*NOINP") Then
            Range(ra).Delete
            nblignes = Range("A6").End(xlDown).Row
        Else
            If (Not Range(ra).Value Like "*#*") Then
                Range(ra).Delete
                nblignes = Range("A6").End(xlDown).Row
            End If
 
        End If
 
        i = i + 1
    Wend
 
End Function
 
Function concatener()
    Dim nblignes As Integer
    Dim i As Integer
 
    'On compte le nombre de lignes
    nblignes = Range("A6").End(xlDown).Row
 
    i = 1
 
    'Tant que i<nblignes, on parcours les lignes et on vérifis certaisn choses
    While (i < nblignes)
 
 
        ra = "A" & i
        ra2 = "A" & i + 1
 
        While (Range(ra).Value Like "*&")
            Range(ra).Value = Range(ra).Value + Range(ra2).Value
            Range(ra2).Delete
            nblignes = Range("A6").End(xlDown).Row
        Wend
 
        i = i + 1
 
    Wend
 
End Function

Merci ;)

Citation:

Envoyé par DUCKY_

@El_slapper,

Merci mais je ne comprend pas bien ton code ...

(.../...)

ma philosophie, c'est de traiter caractère par caractère. C'est moche, old school, peu élégant, consommateur de ressources, mais ça marche.(en même temps, les codes élégants aussi...)

Citation:

Envoyé par DUCKY_

Je n'ai qu'un fichier mapping.txt,

le demandeur n'avait qu'un fichier export.txt. Je ne prends pas 2 fichiers, je prends export.txt, et je créée export2.txt. corrigé suivant ses critères à lui.

Citation:

Envoyé par DUCKY_

Pourquoi en prendre 2 ... ? Je ne comprend pas bien les If (Val1 <> 10) And (Val1 <> 13)

merci d'avance,

Val1, c'est la valeur sur la table ascii du caractère lu. Un retour chariot, en général, c'est le caractère 13 suivi du caractère 10(les caractères 1 à 31 ne sont pas vraiment des caractères, ce sont des codes de contrôle). Parfois c'est 13 seul, parfois 10 seul.

Mon code, il retire tous les retours chariot. Si tu veux l'adapter à ton problème, il te faut mémoriser le caractère lu précédent. du genre(mais à adapter) :
Code:

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 Sub EradicationRetourChariot() Dim NumFich1 As Integer, NumFich2 As Integer Dim NomFich1 As String, Nomfich2 As String Dim Pos1 As Long, Pos2 As Long, Val1 As Integer Dim CaractereLu As String * 1, CaracterePrecedent As String * 1 NumFich1 = FreeFile NomFich1 = "Z:\mapping.txt" Open NomFich1 For Random As #NumFich1 Len = 1 NumFich2 = FreeFile Nomfich2 = "Z:\mappingcorrige.txt" Open Nomfich2 For Random As #NumFich2 Len = 1 Pos1 = 0 Pos2 = 0 CaracterePrecedent = " " Do While Not EOF(NumFich1) Pos1 = Pos1 + 1 Get #NumFich1, Pos1, CaractereLu Val1 = Asc(CaractereLu) If ((Val1 <> 10) And (Val1 <> 13)) Or CaracterePrecedent <> "&" Then Pos2 = Pos2 + 1 Put #2, Pos2, CaractereLu CaracterePrecedent = CaractereLu End If Loop Close #NumFich1 Close #NumFich2 End Sub
en bref, je mémorise le dernier caractère que j'ai réellement écrit, et si c'est un "&", les caractères de retour chariot le suivant sont écartés. J'écris un fichier de sortie mappingcorrige.txt. Je n'ai rien dans mon fichier EXCEL.

mais ton fichier, il est en .txt, ou tu l'as sous format EXCEL? Dans le premier cas, même pas besoin de l'importer. Dans le deuxième cas, si c'est une seul colonne à modifier, un code plus simple serait :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 Sub modif_mapping() Dim i, nblignes, premier As Integer 'On compte le nombre de lignes nblignes = Range("A6").End(xlDown).Row i = 6 'Tant que i<nblignes, on parcours les lignes et on vérifis certaisn choses While (i < nblignes) If Right(Cells(i, 1), 1) = "&" Then Cells(i, 1) = Cells(i, 1) & Cells(i + 1, 1) Rows(i + 1).Delete Shift:=xlUp nblignes = nblignes - 1 Else i = i + 1 End If Wend End Sub
qui évite une recursivité toujours ennuyeuse à maintenir dans le temps.