Répétition de fonction

**romain8544** · 13/06/2016, 11h46

Bonjour,

j'ai un code de KIOUANE qui fonctionne très bien. C'est un double tri avec pour valeur 12, 23, 34, 45,... toujours incrémenté de +11.

Je souhaiterais incrémenté 36 fois.

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
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
 
Sub tri()
Application.ScreenUpdating = False
 
Dim a, b As Integer
n = Range("A" & Rows.Count).End(xlUp).Row
 
Sheets("TRI").Select
Range("A3:E" & n).Sort Key1:=Range("B3"), Order1:=xlDescending, Header:= _
        xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortTextAsNumbers
 
 
For j = 1 To 100
   For i = n - 1 To 3 Step -1
 
     If Cells(i, 1).Value = 12 Then
       For y = 1 To n - i
         If Cells(i + y, 1).Value < 12 Then
           a = Cells(i, 1).Offset(0, 1).Resize(, 5).Value
           Cells(i, 1).Value = Cells(i + y, 1).Value
           Cells(i, 1).Offset(0, 1).Resize(, 5).Value = Cells(i + y, 1).Offset(0, 1).Resize(, 5).Value
           Cells(i + y, 1).Value = 12
           Cells(i + y, 1).Offset(0, 1).Resize(, 5).Value = a
           Exit For
          End If
        Next
 
     End If
 
  Next
 
 Next
 
 For j = 3 To 100
   For i = n - 1 To 3 Step -1
 
     If Cells(i, 1).Value = 23 Then
       For y = 1 To n - i
         If Cells(i + y, 1).Value < 23 Then
           a = Cells(i, 1).Offset(0, 1).Resize(, 5).Value
           Cells(i, 1).Value = Cells(i + y, 1).Value
           Cells(i, 1).Offset(0, 1).Resize(, 5).Value = Cells(i + y, 1).Offset(0, 1).Resize(, 5).Value
           Cells(i + y, 1).Value = 23
           Cells(i + y, 1).Offset(0, 1).Resize(, 5).Value = a
           Exit For
          End If
        Next
 
     End If
 
  Next
 
 Next
 
 For j = 3 To 100
   For i = n - 1 To 3 Step -1
 
     If Cells(i, 1).Value = 34 Then
       For y = 1 To n - i
         If Cells(i + y, 1).Value < 34 Then
           a = Cells(i, 1).Offset(0, 1).Resize(, 5).Value
           Cells(i, 1).Value = Cells(i + y, 1).Value
           Cells(i, 1).Offset(0, 1).Resize(, 5).Value = Cells(i + y, 1).Offset(0, 1).Resize(, 5).Value
           Cells(i + y, 1).Value = 34
           Cells(i + y, 1).Offset(0, 1).Resize(, 5).Value = a
           Exit For
          End If
        Next
 
     End If
 
  Next
 
 Next
 
End sub

Il y a t'il une possibilité pour réduire le code, et faire uniquement valeur=n+11 par exemple.

Merci pour votre aide

**Kiouane** · 13/06/2016, 11h54

Oui tu peux en plaçant par exemple un For h = 12 to 408 step 11

**romain8544** · 13/06/2016, 12h06

comme cela?

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 tri()
Application.ScreenUpdating = False
 
Dim a, b As Integer
n = Range("A" & Rows.Count).End(xlUp).Row
 
Sheets("TRI").Select
Range("A3:E" & n).Sort Key1:=Range("B3"), Order1:=xlDescending, Header:= _
        xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortTextAsNumbers
 
For h = 12 To 408 Step 11
    For j = 1 To 100
     For i = n - 1 To 3 Step -1
 
     If Cells(i, 1).Value = 12 Then
       For y = 1 To n - i
         If Cells(i + y, 1).Value < 12 Then
           a = Cells(i, 1).Offset(0, 1).Resize(, 5).Value
           Cells(i, 1).Value = Cells(i + y, 1).Value
           Cells(i, 1).Offset(0, 1).Resize(, 5).Value = Cells(i + y, 1).Offset(0, 1).Resize(, 5).Value
           Cells(i + y, 1).Value = 12
           Cells(i + y, 1).Offset(0, 1).Resize(, 5).Value = a
           Exit For
          End If
        Next
 
     End If
 
  Next h
 
 Next
 
End Sub

**Kiouane** · 13/06/2016, 12h12

Oui normalement, et remplace là où il y a un 12 avec h et le next h met le en dernier.

**romain8544** · 13/06/2016, 12h18

TROP BIEN!! Merci beaucoup.

Voici le code de KIOUANE

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
36
37
38
 
Sub tri()
Application.ScreenUpdating = False
 
Dim a, b As Integer
n = Range("A" & Rows.Count).End(xlUp).Row
 
Sheets("TRI").Select
Range("A3:E" & n).Sort Key1:=Range("B3"), Order1:=xlDescending, Header:= _
        xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortTextAsNumbers
 
 For h = 12 To 408 Step 11
   For j = 1 To 100
     For i = n - 1 To 3 Step -1
 
 
     If Cells(i, 1).Value = h Then
       For y = 1 To n - i
         If Cells(i + y, 1).Value < h Then
           a = Cells(i, 1).Offset(0, 1).Resize(, 5).Value
           Cells(i, 1).Value = Cells(i + y, 1).Value
           Cells(i, 1).Offset(0, 1).Resize(, 5).Value = Cells(i + y, 1).Offset(0, 1).Resize(, 5).Value
           Cells(i + y, 1).Value = h
           Cells(i + y, 1).Offset(0, 1).Resize(, 5).Value = a
           Exit For
          End If
        Next
 
     End If
 
  Next
 
 Next
 
Next h
 
End Sub

**Kiouane** · 13/06/2016, 12h24

Romain, après réflexion, j'ai optimisé la macro pour que le tri spécial s'étend sur toute la ligne, peu importe le nombre de colonne.

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
36
Sub x()
 
Dim a, b As Integer
n = Range("A" & Rows.Count).End(xlUp).Row
 
 
 Range("A3:B" & n).Sort Key1:=Range("B3"), Order1:=xlDescending, Header:= _
        xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortTextAsNumbers
 
For v = 12 To 408 Step 11
  For j = 1 To 100
    For i = n - 1 To 3 Step -1
 
     If Cells(i, 1).Value = v Then
       For y = 1 To n - i
         If Cells(i + y, 1).Value < v Then
            Application.CutCopyMode = False
            Cells(i, 1).EntireRow.Cut
            Cells(i + y + 1, 1).Select
            Selection.Insert Shift:=xlDown
 
 
          Exit For
          End If
        Next
 
     End If
 
  Next
 
 Next
Next
 
 
End Sub

**casefayere** · 13/06/2016, 12h25

Code :

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

1
2
3
4
n = Range("A" & Rows.Count).End(xlUp).Row
 
Sheets("TRI").Select
......

et si au moment de l'exécution, tu n'es pas sur la bonne feuille, tu vas te planter, autan se passer des "Select" et utiliser "With"

Code :

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

1
2
3
4
5
6
7
8
9
With Sheets("TRI")
  n = .Range("A" & .Rows.Count).End(xlUp).Row
  .Range("A3:E" & n).Sort Key1:=.Range("B3"), Order1:=xlDescending, Header:= _
        xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortTextAsNumber
'et un "." devant "Cells"
'.......
'.....
End With

**romain8544** · 13/06/2016, 12h32

Merci pour vos réponses, ça m'a bien aidé.

Répétition de fonction

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager