Discussion :

[iliesss]

Bonjour

je souhaite savoir comment répéter l'exécution une boucle deux fois d'un une macro

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub Excdeusfois()
Dim Arr
Dern = Range("A" & Rows.Count).End(xlUp).Row
Arr = Range("A2:K" & Dern)
Set a = CreateObject("Scripting.Dictionary")
 
 
For i = LBound(Arr) To UBound(Arr)
    Mle = Arr(i, 3) & Arr(i, 4)
 
    If Not a.Exists(Mle) Then
        a.Add Mle, Mle
    End If
 
Next i
 
k = 2
For Each c In a.keys
    Range("M" & k).Value = Left(a.Item(c), 3)
    Range("N" & k).Value = Right(a.Item(c), 7)
    k = k + 1
Next c
 
'je souhaite que le code demmare de nouveau a partir For i = LBound(Arr) To UBound(Arr) et se termine juste apres la fin de cette boucle et dirige vers N°2
 
N°2:
'=================================
 
 
 
 
'=================================
 
 
End Sub

Merci

[ARTURO83]

Bonjour,

En mettant le tout dans une autre boucle

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Sub Excdeusfois()
    Dim Arr
    Dern = Range("A" & Rows.Count).End(xlUp).Row
    Arr = Range("A2:K" & Dern)
    Set a = CreateObject("Scripting.Dictionary")
 
    For j = 1 To 2 '2 passages
        For i = LBound(Arr) To UBound(Arr)
            Mle = Arr(i, 3) & Arr(i, 4)
            If Not a.Exists(Mle) Then
                a.Add Mle, Mle
            End If
        Next i
 
        k = 2
        For Each c In a.keys
            Range("M" & k).Value = Left(a.Item(c), 3)
            Range("N" & k).Value = Right(a.Item(c), 7)
            k = k + 1
        Next c
    Next j
End Sub

Cdlt

[iliesss]

Bonjour
Merci Mr ARTURO
Oui C'est une très bonne idée mais je souhaite répéter que cette boucle

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
 
For i = LBound(Arr) To UBound(Arr)
    Mle = Arr(i, 3) & Arr(i, 4)
 
    If Not a.Exists(Mle) Then
        a.Add Mle, Mle
    End If
 
Next i

Ou bien je doit repier cette boucle et la coller avant la fin du code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub Excdeusfois()
Dim Arr
Dern = Range("A" & Rows.Count).End(xlUp).Row
Arr = Range("A2:K" & Dern)
Set a = CreateObject("Scripting.Dictionary")
 
 
For i = LBound(Arr) To UBound(Arr)
    Mle = Arr(i, 3) & Arr(i, 4)
 
    If Not a.Exists(Mle) Then
        a.Add Mle, Mle
    End If
 
Next i
 
k = 2
For Each c In a.keys
    Range("M" & k).Value = Left(a.Item(c), 3)
    Range("N" & k).Value = Right(a.Item(c), 7)
    k = k + 1
Next c
 
 '=========== Ici commence La répétition de la boucle=========================
For i = LBound(Arr) To UBound(Arr)
    Mle = Arr(i, 3) & Arr(i, 4)
 
    If Not a.Exists(Mle) Then
        a.Add Mle, Mle
    End If
 
Next i 
 
End Sub

[Jean-Philippe André]

Salut,

en imbriquant le tout dans une boucle et en ajoutant un test

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub Excdeusfois()
Dim Arr
Dern = Range("A" & Rows.Count).End(xlUp).Row
Arr = Range("A2:K" & Dern)
Set a = CreateObject("Scripting.Dictionary")
Dim j as Integer 'ajout
For j=1 To 2 'ajout
For i = LBound(Arr) To UBound(Arr)
    Mle = Arr(i, 3) & Arr(i, 4)
 
    If Not a.Exists(Mle) Then
        a.Add Mle, Mle
    End If
 
Next i
if j=1 Then
k = 2
For Each c In a.keys
    Range("M" & k).Value = Left(a.Item(c), 3)
    Range("N" & k).Value = Right(a.Item(c), 7)
    k = k + 1
Next c
 End IF
 
 
Next j 'ajout
 
End Sub

[iliesss]

Salut
Merci Beaucoup Mr Jean-Philippe André c'est une très bonne idée et ca fonctionne très bien.
Merci à tous ceux qui m'ont aidé à résoudre ce problème et J'ai appris quelque chose de nouveau.