Discussion :

[lecrocmit]

Bonjour à tous,

Je viens de découvrir récemment les macros et je ne fais que des compteurs for.
Je recopie donc à chaque fois strictement la même chose (des centaines de fois...) en ne changeant qu'une seule condition et je suis sur qu'il serait possible de condenser çà en un seul code.
Voici donc mon code (j'ai mis en rouge ce qui change à chaque recopiage) :

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
Sub CoutMS2()
'
' CoutMS2 Macro
'

'
Set wksEI = Sheets("Extraction Instal")
Set wksEO = Sheets("Extraction OS")
Set wksSC = Sheets("Suivi Coûts MS2")
                                                   
wksEI.Select
Buf1 = wksEI.Cells(2, 4).Value
Cpt1 = 0
For a = 1 To 60000
If cells(a,18)="IDF" Then
    If InStr(Cells(a, 7), "vrac") > 0 Then
        If wksEI.Cells(a, 4) <> Buf1 Then
        Cpt1 = Cpt1 + 1
        Buf1 = wksEI.Cells(a, 4).Value
        End If
    End If
End If
Next a
wksSC.Cells(8, 2) = Cpt1
 
wksEI.Select
Buf1 = wksEI.Cells(2, 4).Value
Cpt1 = 0
For a = 1 To 60000
If cells(a,18)="VDR" Then
    If InStr(Cells(a, 7), "vrac") > 0 Then
        If wksEI.Cells(a, 4) <> Buf1 Then
        Cpt1 = Cpt1 + 1
        Buf1 = wksEI.Cells(a, 4).Value
        End If
    End If
End If
Next a
wksSC.Cells(9, 2) = Cpt1

et ainsi de suite...
Si quelqu'un à une idée je suis preneur.

[Ashireon]

Hello,

d'ou proviennent "vrac" , IDF ? Tu descends toujours que d'une ligne ?

Mets entre balise ton code stp.

:-)

[Marc-L]

Bonjour.

Merci d'indenter ton code et de le publier avec l'icône prévu à cet effet …

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
Sub CoutMS2()
    Sheets("Extraction Instal").Activate
 
    For Each Code In Split("IDF VDR")
        Buf1 = Cells(2, 4).Value
        Cpt1 = 0
           R = R + 1
 
        For a = 1 To 60000
            If Cells(a, 18) = Code And InStr(Cells(a, 7), "vrac") And Cells(a, 4) <> Buf1 Then
                Cpt1 = Cpt1 + 1
                Buf1 = Cells(a, 4).Value
            End If
        Next a
 
        Sheets("Suivi Coûts MS2").Cells(7 + R, 2) = Cpt1
    Next Code
End Sub

_______________________________________________________________________________

Merci de cliquer sur pour chaque message ayant aidé puis sur pour clore cette discussion …

[lecrocmit]

En faîte, c'est la toute 1ère fois que je pose une question dans un forum
J'avais toujours trouvé mon bonheur jusqu'à présent mais pas là
Donc avec des balises :

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
Sub CoutMS2()
'
' CoutMS2 Macro
'
 
'
Set wksEI = Sheets("Extraction Instal")
Set wksEO = Sheets("Extraction OS")
Set wksSC = Sheets("Suivi Coûts MS2")
 
wksEI.Select
Buf1 = wksEI.Cells(2, 4).Value
Cpt1 = 0
For a = 1 To 60000
If cells(a,18)="IDF" Then
If InStr(Cells(a, 7), "vrac") > 0 Then
If wksEI.Cells(a, 4) <> Buf1 Then
Cpt1 = Cpt1 + 1
Buf1 = wksEI.Cells(a, 4).Value
End If
End If
End If
Next a
wksSC.Cells(8, 2) = Cpt1
 
wksEI.Select
Buf1 = wksEI.Cells(2, 4).Value
Cpt1 = 0
For a = 1 To 60000
If cells(a,18)="VDR" Then
If InStr(Cells(a, 7), "vrac") > 0 Then
If wksEI.Cells(a, 4) <> Buf1 Then
Cpt1 = Cpt1 + 1
Buf1 = wksEI.Cells(a, 4).Value
End If
End If
End If
Next a
wksSC.Cells(9, 2) = Cpt1

Donc oui je descends que d'une ligne pour remplir un tableau, puis après je recommence dans une autre colonne en ne changeant ce coup-ci qu'une autre condition, dans ce cas là je vais remplacer "vrac" par "vide".
je mets en pj un exemple d'extraction et le tableau à remplir. (bien sur les numéro de colonne et de ligne ne correspondent plus mais c'est pour illustrer un peu, buf1 c'est la colonne 2 dans cet exemple)

J'ai lu un peu les règles du forum, mais si jamais j'oublie des trucs, n'hésitez pas à me rappeler à l'ordre.

oups je n'avais pas vu le message d'avant et je ne savais pas non plus ce que voulait dire indenter, donc voilà :

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
Set wksEI = Sheets("Extraction Instal")
Set wksEO = Sheets("Extraction OS")
Set wksSC = Sheets("Suivi Coûts National")

wksEI.Select
Buf1 = Sheets("Extraction Instal").Cells(2, 4).Value
Cpt1 = 0
For a = 1 To 60000
If Cells(a, 18) = "IDF" Then
    If InStr(Cells(a, 7), "vrac") > 0 Then
        If wksEI.Cells(a, 4) <> Buf1 Then
        Cpt1 = Cpt1 + 1
        Buf1 = wksEI.Cells(a, 4).Value
        End If
    End If
End If
Next a
wksSC.Cells(8, 2) = Cpt1

wksEI.Select
Buf1 = Sheets("Extraction Instal").Cells(2, 4).Value
Cpt1 = 0
For a = 1 To 60000
If Cells(a, 18) = "VDR" Then
    If InStr(Cells(a, 7), "vrac") > 0 Then
        If wksEI.Cells(a, 4) <> Buf1 Then
        Cpt1 = Cpt1 + 1
        Buf1 = wksEI.Cells(a, 4).Value
        End If
    End If
End If
Next a
wksSC.Cells(9, 2) = Cpt1

Comme je disais juste avant, après je recommence en changeant "vrac" par "vide" et en me décalant d'une colonne sur le tableau de résultat.

la pièce jointe...

[Marc-L]

Version plus véloce que la précédente :

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
Sub CoutMS2()
    Sheets("Extraction Instal").Activate
 
    For Each Code In Split("IDF VDR")
          Buf1 = Cells(2, 4).Value
          Cpt1 = 0
             R = R + 1
        Set Rg = Columns(18).Find(Code, , xlValues, xlWhole, , , True)
 
        If Not Rg Is Nothing Then
            A = Rg.Address
 
            Do
                If InStr(Rg.Offset(, -11), "vrac") And Rg.Offset(, -14) <> Buf1 Then
                    Cpt1 = Cpt1 + 1
                    Buf1 = Rg.Offset(, -14).Value
                End If
 
                Set Rg = Columns(18).FindNext(Rg)
            Loop Until Rg.Address = A
        End If
 
        Sheets("Suivi Coûts MS2").Cells(7 + R, 2) = Cpt1
    Next Code
End Sub

_______________________________________________________________________________

Merci de cliquer sur pour chaque message ayant aidé puis sur pour clore cette discussion …


________________________________________________________
Les seins des femmes sont la preuve qu'un homme peut se concentrer sur deux choses à la fois !

[patricktoulon]

Bonjour

je n'est pas tester mais ca doit donner ca

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
 
Sub CoutMS2()
Set wksEI = Sheets("Extraction Instal")
Set wksEO = Sheets("Extraction OS")
Set wksSC = Sheets("Suivi Coûts MS2")
code = Array("IDF", "VDR")
lignecel = Array(8, 9)
For i = 1 To UBound(code) - 1
With wksEI
Buf1 = .Cells(2, 4).Value
Cpt1 = 0
For a = 1 To .Range("A" & Rows.Count).End(xlUp).Row
If .Cells(a, 18) = code(i) And InStr(.Cells(a, 7), "vrac") > 0 And .Cells(a, 4) <> Buf1 Then
Cpt1 = Cpt1 + 1
Buf1 = .Cells(a, 4).Value
End If
Next a
End With
wksSC.Cells(lignecel(i), 2) = Cpt1
Next i

bien que l'on pourrais l'accelerer encore en utilisant des tableaux

et voila une methode avec une variable tableau(50% de rapidité d'execution de gagné)

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 CoutMS2()
Set wksEI = Sheets("Extraction Instal")
Set wksEO = Sheets("Extraction OS")
Set wksSC = Sheets("Suivi Coûts MS2")
Dim tablo As Variant
Dim code, lignecel
code = Array("IDF", "VDR")
lignecel = Array(8, 9)
 tablo = wksEI.Range("a1:s" & Range("A" & Rows.Count).End(xlUp).Row)
For i = 1 To UBound(code)
Buf1 = tablo(2, 4).Value
Cpt1 = 0
For a = 1 To UBound(tablo)
If tablo(1, 18) = code(i) And InStr(tablo(a, 7), "vrac") > 0 And tablo(a, 4) <> Buf1 Then
Cpt1 = Cpt1 + 1
Buf1 = tablo(a, 4).Value
End If
Next a
wksSC.Cells(lignecel(i), 2) = Cpt1
Next i
End Sub