Probleme avec doublons

Re

Essayez comme ceci

Sub test()
Dim sBuf As String, sTemp As String, sFileName As String
Dim textelig As String, texterepl As String
Dim iFileNum As Integer, I As Integer, ligne As Integer
Dim c As Range

With Sheets("DATA").ListObjects(1)
    For Each c In .ListColumns(1).DataBodyRange

        sFileName = .DataBodyRange(c.Row - .HeaderRowRange.Row, 7) & c.Value & ".txt" 'repertoire et nom du fichier txt
        ligne = .DataBodyRange(c.Row - .HeaderRowRange.Row, 2) 'numero ligne en fichier text
        textelig = .DataBodyRange(c.Row - .HeaderRowRange.Row, 3)'texte existant dans la ligne du fichier txt
        texterepl = .DataBodyRange(c.Row - .HeaderRowRange.Row, 9)'texte à remplacer dans la ligne du fichier txt
        iFileNum = FreeFile

        Open sFileName For Input As iFileNum

        Do Until EOF(iFileNum)
            Line Input #iFileNum, sBuf
            I = I + 1
            If I = ligne Then
              sBuf = Replace(sBuf, textelig, texterepl)
            End If
            sTemp = sTemp & sBuf & vbCrLf
        Loop
        Close iFileNum

        iFileNum = FreeFile
        sFileName = .DataBodyRange(c.Row - .HeaderRowRange.Row, 7) & ".txt"
        Open sFileName For Output As iFileNum
        Print #iFileNum, sTemp
        Close iFileNum
        sTemp = ""
    Next c
End With
End Sub

Il faut l'extension txt à vos fichiers
Le code changera le texte dans le fichier txt défini en colonne A de votre tableau en feuille DATA

si ok et terminé pensez à

Cordialement

Edit : attention j'ai modifié
- la ligne sfilename =... à la fin du code et rajouté stemp = "" à la fin du code
- les 4 lignes en dessous de For each c In....

Modifié sfilename à la fin du code

salut dan,

j'ai une erreur 53 : fichier introuvable

le débogueur m'envoi sur : Open sFileName For Input As iFileNum

Bonjour

Que vaut sFilename au moment de l'erreur ?

Comme je vous ai écrit, vos fichiers doivent avoir l'extension txt et le nom doit être identique à ce que vous avez en colonne A bien entendu

Dan,

oui oui j'ai bien fait attention au nom et à l'extension.

par contre je ne sait pas comment faire pour repondre à votre question :

Que vaut sFilename au moment de l'erreur ?

Une fois que le code est sur la ligne d'erreur, mettez votre souris sur sfilename pour voir ce que cela vous donne

Si vous avez un erreur il y a fort à parier que le nom de fichier défini au début du code n'est pas correct ou n'est pas trouvé dans le répertoire

dan,

voila ce qui est indiqué au moment du bug

sfilename="monfichier1.txtmonfichier1.txt.txt"

le nom et le chemin indiqué dans le tableau sont forcements corrects car récupérer par une autre macro et mon code doubleclick fonctionne.

voila ce qui est indiqué au moment du bug sfilename="monfichier1.txtmonfichier1.txt.txt"

Rajoutez ceci juste en dessous de l'instruction sTemp = ""

sfilename = ""

ça produit la même erreur

Juste avant la ligne d'erreur mettez cette instruction pour connaitre la ligne

MsgBox .DataBodyRange(c.Row - .HeaderRowRange.Row, 1)

Cela doit vous donner ce que vous avez comme nom de fichier en colonne A

oui.

ça me donne bien le bon nom de mon fichier : monfichier1.txt

essayez comme ceci

Sub test()
Dim sBuf As String, sTemp As String, sFileName As String
Dim textelig As String, texterepl As String
Dim iFileNum As Integer, I As Integer, ligne As Integer
Dim c As Range

With Sheets("DATA").ListObjects(1)
    For Each c In .ListColumns(1).DataBodyRange

        sFileName = .DataBodyRange(c.Row - .HeaderRowRange.Row, 7) & c.Value '& ".txt" 'repertoire et nom du fichier txt
        ligne = .DataBodyRange(c.Row - .HeaderRowRange.Row, 2) 'numero ligne en fichier text
        textelig = .DataBodyRange(c.Row - .HeaderRowRange.Row, 3) 'texte existant dans la ligne du fichier txt
        texterepl = .DataBodyRange(c.Row - .HeaderRowRange.Row, 9) 'texte à remplacer dans la ligne du fichier txt

        iFileNum = FreeFile

        Open sFileName For Input As iFileNum

        Do Until EOF(iFileNum)
            Line Input #iFileNum, sBuf
            I = I + 1
            If I = ligne Then
              sBuf = Replace(sBuf, textelig, texterepl)
            End If
            sTemp = sTemp & sBuf & vbCrLf
        Loop

        Close iFileNum

        iFileNum = FreeFile
        sFileName = .DataBodyRange(c.Row - .HeaderRowRange.Row, 7) & c.Value '& ".txt"
        Open sFileName For Output As iFileNum
        Print #iFileNum, sTemp
        Close iFileNum
        sTemp = ""
        I = 0
        'sFileName = ""
    Next c
End With
End Sub

Crdlt

super , tout fonctionne comme je le souhaitai.

merci beaucoup Dan.

Rechercher des sujets similaires à "probleme doublons"