Next For au sein d'un with Range

Version imprimable

Voir 40 message(s) de cette discussion en une page

Bonjour,

Mon code ci dessous m'informe d'une incompatibilité de type et je me pose la question si un next est possible dans un with

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub ajout()
Dim i As String
Dim j As String
Dim k As String
 
i = Workbooks("Production 1 .xls").Sheets("Production 1 ").Cells(65535, 1).End(xlUp)(1).Row
j = Workbooks("TESTCALCULRCV.xlsm").Sheets("MPH").Cells(65535, 1).End(xlUp)(2).Row
 
With Workbooks("TESTCALCULRCV.xlsm").Sheets("MPH")
 
    .Range("A" & j & ":J" & (i * 2) - 1).Value = Workbooks("Production 1 .xls").Sheets("Production 1 ").Range("A2:J" & j - 1).Value
    For k = 1 To i
    .Range("K" & j) = "=IFERROR(IF(rstnum(I & i),I & i,VALUE(REPLACE(I & i,SEARCH("","",I & i,1),1,"".""))),0)"
    Next k
End With
 
End Sub

Merci de votre aide

Code:

1
2
i = Workbooks("Production 1 .xls").Sheets("Production 1 ").Cells(65535, 1).End(xlUp)(1).Row
j = Workbooks("TESTCALCULRCV.xlsm").Sheets("MPH").Cells(65535, 1).End(xlUp)(2).Row

Si
i est inférieur ou égal à 1
ou j inférieur ou égal à 2,
erreur

15/11/2013, 15h21
ALEX80800

Désolé je n'ai compris la réponse
15/11/2013, 15h27
EngueEngue

Ton erreur vient du fait que:

Soit i vaut 1 soit j vaut 1

Soit tes noms de classeurs ou de feuilles sont mal écrits

Workbooks("Production 1 .xls").Sheets("Production 1 ")

Tu es sûr pour l'espace après le 1 de production ?
15/11/2013, 15h30
ALEX80800

Oui je suis sûr car le code a fonctionné avant je veuille mettre la formule de calcule

Dans la fenêtre "Variables locales"
i = 1499
et j 1498
ou inversement
15/11/2013, 15h33
EngueEngue

Code:

.Range("K" & j).formula = "=IFERROR(IF(rstnum(I & i),I & i,VALUE(REPLACE(I & i,SEARCH("""","""",I & i,1),1,"""".""""))),0)"
15/11/2013, 15h40
ALEX80800

Ok pour le code mais pour rappel

Le code avant calcul incrémente la valeur de 1498 lignes et si j'applique ta formule tel que tu me la changer elle s'applique sur la dernière ligne.
Alors que j'essayais suite à l'incrémentation de ces 1498 lignes leur affecter la formule de calcul pour chacune d'entre elle
15/11/2013, 16h17
EngueEngue

Je n'ai rien changé à ta formule, je me suis contenté de bien l'écrire.

Edit: en effet je viens de capter.. Tu boucles sur "k" et tu changes la ligne "j"
Change le j par k et ça devrait le faire ?
15/11/2013, 16h25
ALEX80800

Ok
mais pour la boucle que dois je faire ou qu'est ce ui ne va pas?
15/11/2013, 16h29
EngueEngue

Code:

.Range("K" & k).formula = "=IFERROR(IF(rstnum(I & i),I & i,VALUE(REPLACE(I & i,SEARCH("""","""",I & i,1),1,"""".""""))),0)"
15/11/2013, 16h33
mercatog

Et aussi mettre .." & i &"... au lieu de ..i... dans la formule.

i étant une variable
15/11/2013, 16h41
EngueEngue

Bien vu, je n'avais pas fait gaffe!

Donc j'ai modifié mon code comme suit
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 Sub ajout() Dim i As Integer Dim j As Integer Dim k As Integer i = Workbooks("Production[2].xls").Sheets("Production 2 ").Cells(65535, 1).End(xlUp)(1).Row j = Workbooks("TESTCALCULRCV.xlsm").Sheets("MPH").Cells(65535, 1).End(xlUp)(2).Row With Workbooks("TESTCALCULRCV.xlsm").Sheets("MPH") For k = 0 To j .Range("K" & j + k).Formula = "=IFERROR(IF(rstnum(I & j+k),I & j+j,VALUE(REPLACE(I & j+k,SEARCH("","",I & j+k,1),1,"".""))),0)" Next k .Range("A" & j & ":J" & (i * 2) - 1).Value = Workbooks("Production[2].xls").Sheets("Production 2 ").Range("A2:J" & j - 1).Value End With End Sub
Il me reste à définir le supplément de 3 lignes de calcul en plus.

Par contre dans les cellules j'ai ce type de fomule

Code:

=SIERREUR(SI(rstnum(I & j+k);I & j+j;CNUM(REMPLACER(I & j+k;CHERCHE(",";I & j+k;1);1;".")));0)

Alors que je m'attendais à voir au lieu de I & j+k a avoir I2509 pour la ligne 2509

15/11/2013, 16h49
EngueEngue

Cf la remarque de mercatog

Code:

"=IFERROR(IF(rstnum(I" & j+k & "),I" & j+j & ",VALUE(REPLACE(I" & j+k & ",SEARCH("","",I" & j+k&",1),1,"".""))),0)"

Petit complément d'info suite évolution macro

Donc suite à vos éclairages j'ai fait évoluer mon code mais je rencontre un souci sur la variable Fich et en conséquence i

Car quand je lance avec le lecteur le code suivant cela fonctionne et si je relance une deuxième fois la varaible Fich n'est pas reconnue

J'ai pas d'idée sur cet état de fait

Merci de votre aide

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
Sub ajout()
 
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim wb As Excel.Workbook
Dim Fich As String
 
 
j = Workbooks("TESTCALCULRCV.xlsm").Sheets("MPH").Cells(65535, 1).End(xlUp)(1).Row
 
For Each wb In Application.Workbooks
    If wb.Name Like "production*" Then
      wb.Activate:  Exit For
      'nom du classeur actif
    Fich = ActiveWorkbook.Name
     i = Workbooks(Fich).Sheets(1).Cells(65535, 1).End(xlUp)(1).Row
      End If
Next wb
 
 
 
    With Workbooks("TESTCALCULRCV.xlsm").Sheets("MPH")
 
   .Range("A" & j & ":J" & j + i).Value = Workbooks(Fich).Sheets(1).Range("A2:J" & j).Value
    For k = 0 To i
   .Range("K" & j + k).Formula = "=IFERROR(IF(isnumber(I" & j + k & "),I" & j + k & ",VALUE(REPLACE(I" & j + k & ",SEARCH("","",I" & j + k & ",1),1,"".""))),0)"
    Next k
    End With
 
 
End Sub

Essaies comme 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
Sub Ajout()
Dim i As Long, j As Long
Dim Trouve As Boolean
Dim Wb As Workbook
Dim Ws As Worksheet
 
For Each Wb In Application.Workbooks
    If Wb.Name Like "production*" Then
        Trouve = True
        Exit For
    End If
Next Wb
 
If Trouve Then
    Set Ws = Wb.Worksheets(1)
    i = Ws.Cells(Ws.Rows.Count, 1).End(xlUp).Row
    With Workbooks("TESTCALCULRCV.xlsm").Worksheets("MPH")
        j = .Cells(.Rows.Count, 1).End(xlUp).Row
        .Range("A" & j & ":J" & j + i).Value = Ws.Range("A2:J" & j).Value
        .Range("K" & j & "K" & j + i).Formula = "=IFERROR(IF(ISNUMBER(I" & j & "),I" & j & ",VALUE(REPLACE(I" & j & ",SEARCH("","",I" & j & ",1),1,"".""))),0)"
    End With
    Set Ws = Nothing
    Set Wb = Nothing
End If
End Sub

Si le classeur contenant la macro est TESTCALCULRCV.xlsm, alors remplace la ligne 17 par

Code:

With ThisWorkbook.Worksheets("MPH")

19/11/2013, 09h52
ALEX80800
Bonjour,

Merci de la prompte réponse.

Et merci pour m'avoir aiguillé sur le code permettant de cibler le fichier qui porte la macro

Il ne reconnaît toujours pas le fichier "Production2.xls"

Ce que je ne comprends pas c'est qu'en effectuant ce code
Code:

1 2 3 4 5 6 7 8 Sub listeWB() Dim Wb As Workbook Dim txt As String For Each Wb In Workbooks txt = txt & Wb.Name & vbCrLf Next Wb MsgBox txt End Sub
La MsgBOx restitue ""TESTCALCULRCV.slxm" et "Production2.xls"

Et en testant le code rectifié par chacun d'entre vous rien ne s'exécute et wb = nothing dans la fenêtre variables locales
19/11/2013, 09h59
EngueEngue

Code:

If Wb.Name Like "production*"

"production*" = "Production*" ?

Code:

If Wb.Name Like "Production*"
19/11/2013, 10h00
mercatog

Erreur de débutant pour toi quand à l'utilisation de Like

Remplace la ligne 8 par

Code:

If LCase(Wb.Name) Like "production*" Then
19/11/2013, 10h05
ALEX80800

Effectivement, j'en suis honteux

Résolu un grand Grand GRand GRANd GRAND MERCI

Voir 40 message(s) de cette discussion en une page