Erreur avec la fonction Replace

Version imprimable

bonjour le forum,

A l'aide du code ci dessous, je souhaite ouvrir un fichier .txt, remplacer les valeurs nulles par " " afin de pouvoir faire une moyenne et de calculer l'écart type pour importer le tout dans un autre fichier. A chaque fois que je lance la macro, une erreur type 438 apparait sur la ligne de la fonction Replace :calim2: (ligne en rouge dans le code)

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
Option Explicit
Sub Resistivity()

Dim WB As Workbook, TreatedFile As Workbook
Dim Counter As Variant 'Declaration de counter
Dim a As Integer 
Dim nom As String, ave As String, deviation As String, unit  As String    
Dim maximum As String, minimum As String
Dim dl As String, dc As String

Set WB = ThisWorkbook  'creation d'un nouveau fichier
Application.ScreenUpdating = False

Counter = Application.GetOpenFilename(",*.map", , , , True) 'Ouverture de la boite de dialogue pour selection des fichiers .txt
If VarType(Counter) = vbBoolean Then Exit Sub

For a = 1 To UBound(Counter)
      
    Set TreatedFile = Application.Workbooks.Open(Counter(a), xlMSDOS)
    
    With TreatedFile
        dl = Range("A65536").End(xlUp).Row
        dc = Range("IV1").End(xlToLeft).Column
        
        .Range(Cells(4, 1), Cells(CInt(dl), CInt(dc))).Replace What:="0", Replacement:=" " , LookAt:=xlWhole
               
        nom = Worksheets(1).Name
        maximum = Application.WorksheetFunction.max(Range(Cells(4, 1), Cells(CInt(dl), CInt(dc))))
        minimum = Application.WorksheetFunction.Min(Range(Cells(4, 1), Cells(CInt(dl), CInt(dc))))
        ave = Application.WorksheetFunction.average(Range(Cells(4, 1), Cells(CInt(dl), CInt(dc))))
        deviation = Application.WorksheetFunction.StDev(Range(Cells(4, 1), Cells(CInt(dl), CInt(dc))))
        
        If a = UBound(Counter) Then unit = Range("E2")
        .Close (False)
     End With
    
    With WB.Worksheets(1)
        .Range("A" & a + 2) = nom
        .Range("B" & a + 2) = ave
        .Range("C" & a + 2) = deviation
        .Range("D" & a + 2) = maximum
        .Range("E" & a + 2) = minimum
    End With

Next a 'fin condition

Au début je nommais explicitement les cellules dans la ligne ou la fonction replace apparait (ex: Range("B4:F9)) et cela fonctionnait bien. Depuis que j'ai changé, ca plante...

Avez vous une idée?

Merci d'avance,
Johann

28/08/2009, 15h25
Minick

SAlut,

Essaie d'enlever le point devant range

Re,

Je viens de trouver une solution tout à fait déconcertance....:aie:
Il suffit tout simplement de mettre l'indice de la feuille devant Range...:oops:
Code:

1 2 3 4 5 6 With TreatedFile dl = Range("A65536").End(xlUp).Row dc = Range("IV1").End(xlToLeft).Column .Worksheets(1).Range(Cells(4, 1), Cells(CInt(dl), CInt(dc))).Replace What:="0", Replacement:=" " , LookAt:=xlWhole
Merci Minick pour ta réponse, ca marche aussi. Pour dire la vérité, je comprends pas très bien pourquoi... Pourrais tu m'expliquer STP?

johann

28/08/2009, 15h36
david_atx

tout simplement quand tu enlève le point tu sous entend que tu ne travaille pas avec treated file mais avec la feuille active donc si la feuille active est la bonne bingo
28/08/2009, 15h38
johannj

Merci david pour ta précision, c'est bon à savoir

:ccool:

tout smplement parce que

Code:

With TreatedFile

permet une simplification d'ecriture au niveau du fichier que tu viens
d'ouvrir mais pas au niveau de la feuille active.

donc si tu utilises le point(.) tu accedes aux proprietes et methodes
du classeur et non de la feuille.

D'ailleurs si tu veux etre plus rigoureux il faudrait faire ceci

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
Option Explicit
Sub Resistivity()
 
Dim WB As Workbook, TreatedFile As Workbook
Dim Counter As Variant 'Declaration de counter
Dim a As Integer 
Dim nom As String, ave As String, deviation As String, unit  As String    
Dim maximum As String, minimum As String
Dim dl As String, dc As String
 
Set WB = ThisWorkbook  'creation d'un nouveau fichier
Application.ScreenUpdating = False
 
Counter = Application.GetOpenFilename(",*.map", , , , True) 'Ouverture de la boite de dialogue pour selection des fichiers .txt
If VarType(Counter) = vbBoolean Then Exit Sub
 
For a = 1 To UBound(Counter)
 
    Set TreatedFile = Application.Workbooks.Open(Counter(a), xlMSDOS)
 
    With TreatedFile
        With .Activesheet
            dl = .Range("A65536").End(xlUp).Row
            dc = .Range("IV1").End(xlToLeft).Column
 
            .Range(.Cells(4, 1), .Cells(CInt(dl), CInt(dc))).Replace What:="0", Replacement:=" " , LookAt:=xlWhole
 
            nom = .Name
            maximum = Application.WorksheetFunction.max(.Range(.Cells(4, 1), .Cells(CInt(dl), CInt(dc))))
            minimum = Application.WorksheetFunction.Min(.Range(.Cells(4, 1), .Cells(CInt(dl), CInt(dc))))
            ave = Application.WorksheetFunction.average(.Range(.Cells(4, 1), .Cells(CInt(dl), CInt(dc))))
            deviation = Application.WorksheetFunction.StDev(.Range(.Cells(4, 1), .Cells(CInt(dl), CInt(dc))))
 
            If a = UBound(Counter) Then unit = .Range("E2")
        End With
 
        .Close (False)
     End With
 
    With WB.Worksheets(1)
        .Range("A" & a + 2) = nom
        .Range("B" & a + 2) = ave
        .Range("C" & a + 2) = deviation
        .Range("D" & a + 2) = maximum
        .Range("E" & a + 2) = minimum
    End With
 
Next a 'fin condition

A tester (j'ai modifie en direct)