[Excel VBA] Je recherche et remplace des "strings" :-B

Version imprimable

30/11/2006, 15h59
Paloma

[Excel VBA] Je recherche et remplace des "strings" :-B

Non sans rire,

voilà je me demander qu'elle serait la façon la plus simple pour remplacer des caractères dans mots.

En clair, dans mon classeur j'ai :

1 - j'ai une feuille excel (1)
elle contient dans la colonne 3 une liste de fichier

M57110020200000
M57110012200000
M88810020200000
M57110020255555

2 - j'ai une feuille excel (2)

elle contient dans la colonne 1
M571
M888
255555

et elle contient dans la colonne 3 (juste en face)
S888
L754
900000

comment chaque élément trouvé dans Feuille(2),col 1 je trouve toutes les occurences dans feuille(1),col 3 et je remplace par ce que j'ai dans Feuille (2), col3 ?

Si quelqu'un a une petite idée :mrgreen:

Merci

Comme d'hab, je cherche de mons coté (et je ne parle pas de manipuler les chaines de caractères mais juste la méthode de manipulation/stockage pour passer les ordres)

Enfin, j'ai une petie idée avec les tableaux et http://silkyroad.developpez.com/VBA/...nesCaracteres/

Mais je crois qu'en VBA je peux utiliser replace avec Excel ?

Merci
Paloma

Bonjour à tous,

Bon voilà j'ai pondu un truc pour faire mes remplacements de caractères.

voici le 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
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
'*****************************************************************************************
' Generation/Traduction des fichiers
'*****************************************************************************************
Private Sub ButGenerate_Click()
            Dim LigneIn As String
            'Dim LigneOut As String
            Dim LigneExcel As Integer
            Dim compt As Integer
 
            'activer la feuille "Memory" à la ligne 1 -----------------------------------
            'Sheets("Memory").Activate
            LigneExcel = 1
 
            'Inscrire le contenu d'une feuille Excel dans une autre
suite:
            LigneExcel = LigneExcel + 1
 
            LigneIn = Sheets("Work files").Cells(LigneExcel, 3)
 
            If LigneIn = "" Then
                If LigneExcel = 2 And LigneIn = "" Then
                    MsgBox " Not Data transfered, the entry list is empty ! ", vbCritical, "Caution"
                Else
            'Cherche et remplace une chaine de caractère ---------------------------------
            Dim litDico As Integer
            Dim litOut As Integer
            Dim intReturnValue As Integer
            Dim strRead As String
            Dim strReplace As String
 
            litOut = 1
            litDico = 1
newEntry:
            litOut = litOut + 1
 
newLine:
            litDico = litDico + 1
 
            intReturnValue = InStr(1, Sheets("Result").Cells(litOut, 3), Sheets("Memory").Cells(litDico, 1), 1)
            strRead = Sheets("Result").Cells(litOut, 3)
            strReplace = Sheets("Memory").Cells(litDico, 3)
            If intReturnValue = 0 Then
                        If strRead = "" Then
                            GoTo OutIf
                            Else
                            GoTo newLine
                        End If
                Else
 
                    Mid(strRead, intReturnValue, Len(Sheets("Memory").Cells(litDico, 1))) = strReplace
 
                    GoTo newEntry
 
                End If
 
 
OutIf:
 
 
            'Return information success -----------------------------------------------------------------------------
            MsgBox "All files has been processed.", vbExclamation, "Congratulation!"
                End If
 
            Exit Sub
            Else
            Sheets("Result").Cells(LigneExcel, 1) = Sheets("Work files").Cells(LigneExcel, 3)
            Sheets("Result").Cells(LigneExcel, 2) = CStr(";")
            Sheets("Result").Cells(LigneExcel, 3) = LigneIn
            GoTo suite
            End If
        MsgBox "All files has been processed.", vbExclamation, "Congratulation!"
End Sub

Je n'ai pas de message d'erreur mais il ne se passe rien.

j'ai essayé d'utiliser la méthode de bbil pour remplacer les caractère.

Citation:

Par SilkyRoad :
L'instruction MID permet aussi d'effectuer un remplacement dans une chaîne. La position de la chaîne à modifier doit être préalablement connue.
Merci à Bbil pour cette astuce.
VB6-VBA
Sub ModifChaine()
Dim St As String

St = "deceloppez.com"
Debug.Print St

'Oups... une erreur de frappe sur 3° caractère...
'Utilisons Mid pour le modifier
Mid(St, 3, 1) = "v"
Debug.Print St
End Sub

Que se passe-t-il?
Si vous avez une idée, merci.

Bien à vous.

Paloma

01/12/2006, 13h08
SfJ5Rpw8

ben ton programme est illisble avec tous tes goto... le goto ne sont plus utilisé en basic...! où seulement pour la gestion d'erreurs... donc re-écrit ton code en supprimant tous ces gotos inutiles et on en reparle

Bonjour à tous et à toutes,

Bon j'ai du mal mais je vais y parvenir ...

:mrgreen:

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
79
80
81
82
83
84
85
'*****************************************************************************************
' Generation/Traduction des fichiers
'*****************************************************************************************
Private Sub ButGenerate_Click()
            Dim LigneIn As String
            Dim LigneExcel As Integer
            Dim compt As Integer
 
            Dim litDico As Integer
            Dim litOut As Integer
            Dim intReturnValue As Integer
            Dim strRead As String
            Dim strReplace As String
 
            'activer la feuille "Memory" à la ligne 1 -----------------------------------
            'Sheets("Memory").Activate
            LigneExcel = 2
 
            'Inscrire le contenu d'une feuille Excel dans une autre
 
            LigneIn = Sheets("Work files").Cells(LigneExcel, 3)
 
            If LigneIn = "" Then
                    MsgBox " Not Data transfered, the entry list is empty ! ", vbCritical, "Caution"
                Else
 
        For LigneExcel = 2 To 10000
 
            Sheets("Result").Cells(LigneExcel, 1) = Sheets("Work files").Cells(LigneExcel, 3)
            Sheets("Result").Cells(LigneExcel, 2) = CStr(";")
            Sheets("Result").Cells(LigneExcel, 3) = LigneIn
            'Cherche et remplace une chaine de caractère ---------------------------------
 
            litOut = 2
            litDico = 2
 
            litOut = litOut + 1
 
            For litDico = 2 To 10000
            intReturnValue = InStr(1, Sheets("Result").Cells(litOut, 3), Sheets("Memory").Cells(litDico, 1), 1)
            strRead = Sheets("Result").Cells(litOut, 3)
            strReplace = Sheets("Memory").Cells(litDico, 3)
            If intReturnValue = 0 Then
 
                  Else
 
                    Mid(strRead, intReturnValue, Len(Sheets("Memory").Cells(litDico, 1))) = strReplace
                    Sheets("Result").Cells(litOut, 3) = strReplace
 
 
                End If
 
                    Next litDico
 
 
            Exit Sub
 
 
            LigneExcel = LigneExcel + 1
            'GoTo suite
            Next LigneExcel
            End If
            'Return information success -----------------------------------------------------------------------------
            MsgBox "All files has been processed.", vbExclamation, "Congratulation!"
End Sub
 
Private Sub ButBrowse_Click()
'Récupération du chemin de travail
    strPathJob = SelectFolder("Sélectionnez un répertoire :", 0)
 
    If strPathJob <> "" Then
                ' Permet de modifier la valeur Text du champ de texte.
            TxtJobDirectory.Text = strPathJob 'indique le chemin complet
            TxtJobDirectory.BackColor = &H80000005  'change la couleur du label
 
            ButBrowse.Visible = True
            ListFilesInFolder strPathJob, True
            Sheets("Memory").Cells(2, 4) = TxtJobDirectory
        Else
        MsgBox "Please select a job directory only which contain all CATIA files!", vbCritical, "!STOP!"
    End If
 
    Exit Sub
 
End Sub

Donc, je ne sais toujours pas quand j'aurais fini, mais si je fini, je posterais la solution ...

@ plus
Paloma

[Presque ça]

J'y suis presque ;-)

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
'*****************************************************************************************
' Generation/Traduction des fichiers
'*****************************************************************************************
Private Sub ButGenerate_Click()
            Dim LigneIn As String
            Dim LigneExcel As Integer
            Dim compt As Integer
            '- - - - - - - - - - - - - - - -
            Dim litDico As Integer
            Dim litOut As Integer
            Dim intReturnValue As Integer
            Dim strRead As String
            Dim strReplace As String
 
            ' récupération du nombre de fichier à traiter et le nombre de filtres -------
            Call countInFiles
            Call countFilters
 
            'activer la feuille "Memory" à la ligne 1 -----------------------------------
            'Sheets("Memory").Activate
            'LigneExcel = 2
 
            'Inscrire le contenu d'une feuille Excel dans une autre ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
 
            LigneIn = Sheets("Work files").Cells(LigneExcel, 3)
 
            If LigneIn = "" Then
                    MsgBox " Not Data transfered, the entry list is empty ! ", vbCritical, "Caution"
                Else
            End If
 
            For LigneExcel = 2 To nbrEntries
 
            Sheets("Result").Cells(LigneExcel, 1) = Sheets("Work files").Cells(LigneExcel, 3)
            Sheets("Result").Cells(LigneExcel, 2) = CStr(";")
            Sheets("Result").Cells(LigneExcel, 3) = Sheets("Work files").Cells(LigneExcel, 3)
 
            'Cherche et remplace une chaine de caractère ---------------------------------
 
            LigneExcel = 2
            litOut = 1
            litDico = 2
 
            litOut = litOut + 1
 
            For litDico = 2 To nbrFilters
            intReturnValue = InStr(1, Sheets("Result").Cells(litOut, 1), Sheets("Memory").Cells(litDico, 1), 1)
            strRead = Sheets("Result").Cells(litOut, 3)
            strReplace = Sheets("Memory").Cells(litDico, 3)
            If intReturnValue = 0 Then
 
                  Else
 
                    'Mid(strRead, intReturnValue, Len(Sheets("Memory").Cells(litDico, 1))) = strReplace
                    Sheets("Result").Cells(litOut, 3).Replace Sheets("Memory").Cells(litDico, 1), strReplace
 
 
                End If
 
                    Next litDico
 
            Next LigneExcel
 
            'Return information success -----------------------------------------------------------------------------
            MsgBox "All files has been processed.", vbExclamation, "Congratulation!"
End Sub

Cool c'est bon.
Merci.

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
'*****************************************************************************************
' Generation/Traduction des fichiers
'*****************************************************************************************
Private Sub ButGenerate_Click()
            Dim LigneIn As String
            Dim LigneExcel As Integer
            Dim compt As Integer
            '- - - - - - - - - - - - - - - -
            Dim litDico As Integer
            Dim litOut As Integer
            Dim intReturnValue As Integer
            Dim strRead As String
            Dim strReplace As String
 
            ' récupération du nombre de fichier à traiter et le nombre de filtres -------
            Call countInFiles
            Call countFilters
 
            'activer la feuille "Memory" à la ligne 1 -----------------------------------
            'Sheets("Memory").Activate
            LigneExcel = 2
 
            'Inscrire le contenu d'une feuille Excel dans une autre ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
 
            LigneIn = Sheets("Work files").Cells(LigneExcel, 3)
 
            If LigneIn = "" Then
                    MsgBox " Not Data transfered, the entry list is empty ! ", vbCritical, "Caution"
                Else
            End If
 
            For LigneExcel = 2 To nbrEntries
 
            Sheets("Result").Cells(LigneExcel, 1) = Sheets("Work files").Cells(LigneExcel, 3)
            Sheets("Result").Cells(LigneExcel, 2) = CStr(";")
            Sheets("Result").Cells(LigneExcel, 3) = Sheets("Work files").Cells(LigneExcel, 3)
 
            'Cherche et remplace une chaine de caractère ---------------------------------
 
            'LigneExcel = 2
            'litOut = 2
            litDico = 2
 
            For litDico = 2 To nbrFilters
            intReturnValue = InStr(1, Sheets("Result").Cells(LigneExcel, 1), Sheets("Memory").Cells(litDico, 1), 1)
            strRead = Sheets("Result").Cells(LigneExcel, 3)
            strReplace = Sheets("Memory").Cells(litDico, 3)
            If intReturnValue = 0 Then
 
                  Else
 
                    'Mid(strRead, intReturnValue, Len(Sheets("Memory").Cells(litDico, 1))) = strReplace
                    Sheets("Result").Cells(LigneExcel, 3).Replace Sheets("Memory").Cells(litDico, 1), Sheets("Memory").Cells(litDico, 3)
 
 
                End If
 
                    Next litDico
 
            Next LigneExcel
 
            'Return information success -----------------------------------------------------------------------------
            MsgBox "All files has been processed.", vbExclamation, "Congratulation!"
End Sub

@ bientôt.
Cordialement,
Paloma