Programme qui s'execute deux fois

Version imprimable

Bonjour tout le monde,

J'ai ecrit une macro qui fonctionne a cela pres qu'elle s'execute toujours deux fois...

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
Sub HauptgewerkErfüllung()
 
Dim C As Range
Dim Hauptgewerk As Worksheet, GESAMT As Worksheet, HE As Worksheet
Dim Feuille As Worksheet
Dim Such As String, Nom As String
 
Set GESAMT = Workbooks("Gesamt-Tabelle.xls").Worksheets("Tabelle")
Set HE = Workbooks("Versuch.xls").Worksheets("HE")
 
For k = 6 To Worksheets("Makros").Cells(Rows.Count, 8).End(xlUp).Row
    Nom = Worksheets("Makros").Cells(k, 8).Value
 
 
Set Hauptgewerk = Worksheets(Nom)
 
' # Sucht das Blatt die von dem Hauptgewerk betrifft wird
For Each Feuille In Worksheets
' # Sucht die Zeile ins Gesamt Tabelle, wo es die Hauptgewerkergebnisse gibt.
    For Each C In GESAMT.Range("L8:L" & GESAMT.Cells(Rows.Count, 12).End(xlUp).Row)
        If C.Value = 2 And Feuille.Name = C.Offset(0, -11).Value Then
           ' Fügt eine neue Spalte für das Monat ein
                Hauptgewerk.Range("F1").EntireColumn.Insert
                Hauptgewerk.Range("D4") = GESAMT.Range("Z6").Value
                  '   # Erfüllt das Blatt
                Hauptgewerk.Range("B5:B11") = C.Offset(0, -11).Value
                Hauptgewerk.Cells(6, 6) = C.Offset(0, 8).Value + C.Offset(0, 7).Value
 
            End If
 
        Next
 
Next
End Sub

Le but de cette macro est de remplir un tableau identique sur plusieurs feuilles du classeur. Pour naviguer d'une feuille a l'autre, j'ai repertorie les differents noms de feuille dans un tableau dans la feuille "Makros"

Mon probleme est que la macro s'effectue a chaque fois sur toute les feuilles (Si j'ai 3 feuilles, chaque feuille sera rempli 3 fois).

J'ai beau chercher, je vois pas ce qu'il faut que je change.

merci d'avance !

Potzo

bonjour,

là à chaud, ce que je vois c'est une double imbrication

il y a

Code:

1
2
3
4
5
6
7
8
 
'une boucle
for k=6 to ...
    'et la tu passe en revue toute les feuilles... k fois
    for each feuille in worksheets
    ...
    next feuille
next k

16/08/2010, 12h02
grisan29
bonjour, mayekeul et potzo

n'est ce pas pour mis avoir 2 next avant end sub
Code:

1 2 3 4 5 6 End If Next Next End Sub
cordialement

pascal
16/08/2010, 12h44
Didier Gonard

Bonjour,

Le code que tu fournis doit obligatoirement planter tel quel !

Il n'y a pas le nombre de Next correspondants au nombre de For.

Pour s'y retrouver, il est très conseillé de mettre après le for la variable concernée, la lisibilité y gagne de beaucoup, surtout en cas d'imbrication, donc tel quel le code ne se produit même pas 1 fois...

cordialement,

Didier

Concernant le nombre de Next, c'est parce que j'avais coupe une partie du code qui reprenait la meme syntaxe et donc le Next k du coup. Voici mon code complet :

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
49
50
51
Sub HauptgewerkErfüllung()
 
Dim C As Range
Dim Hauptgewerk As Worksheet, GESAMT As Worksheet, HE As Worksheet
Dim Feuille As Worksheet
Dim Such As String, Nom As String
 
Set GESAMT = Workbooks("Gesamt-Tabelle.xls").Worksheets("Tabelle")
Set HE = Workbooks("Versuch.xls").Worksheets("HE")
 
For k = 6 To Worksheets("Makros").Cells(Rows.Count, 8).End(xlUp).Row
    Nom = Worksheets("Makros").Cells(k, 8).Value
 
 
Set Hauptgewerk = Worksheets(Nom)
 
' # Sucht das Blatt die von dem Hauptgewerk betrifft wird
For Each Feuille In Worksheets
' # Sucht die Zeile ins Gesamt Tabelle, wo es die Hauptgewerkergebnisse gibt.
    For Each C In GESAMT.Range("L8:L" & GESAMT.Cells(Rows.Count, 12).End(xlUp).Row)
        If C.Value = 2 And Feuille.Name = C.Offset(0, -11).Value Then
           ' Fügt eine neue Spalte für das Monat ein
                Hauptgewerk.Range("F1").EntireColumn.Insert
                Hauptgewerk.Range("D4") = GESAMT.Range("Z6").Value
          Hauptgewerk.Range("F4") = GESAMT.Range("Z6").Value
            '   # Erfüllt das Blatt
                Hauptgewerk.Range("B5:B11") = C.Offset(0, -11).Value
                Hauptgewerk.Cells(6, 6) = C.Offset(0, 8).Value + C.Offset(0, 7).Value
                Hauptgewerk.Cells(8, 6) = C.Offset(0, 2).Value
                Hauptgewerk.Cells(6, 4).Value = C.Offset(0, 17).Value + C.Offset(0, 16).Value
                Hauptgewerk.Cells(7, 6) = C.Offset(0, 14).Value * C.Offset(0, 2).Value
                Hauptgewerk.Cells(9, 6) = Hauptgewerk.Cells(6, 6) + (Hauptgewerk.Cells(8, 6) - Hauptgewerk.Cells(7, 6))
                Hauptgewerk.Cells(10, 6) = Hauptgewerk.Cells(6, 6) * Hauptgewerk.Cells(8, 6) / Hauptgewerk.Cells(7, 6)
                Hauptgewerk.Cells(11, 6) = Hauptgewerk.Cells(6, 6) + (Hauptgewerk.Cells(8, 6) - Hauptgewerk.Cells(7, 6)) * Hauptgewerk.Cells(5, 6) * Hauptgewerk.Cells(6, 6) / (Hauptgewerk.Cells(7, 6) * Hauptgewerk.Cells(7, 6))
                Hauptgewerk.Cells(12, 6) = Hauptgewerk.Cells(8, 6) - Hauptgewerk.Cells(11, 6)
                Hauptgewerk.Cells(13, 6) = (Hauptgewerk.Cells(8, 6) - Hauptgewerk.Cells(7, 6)) / (Hauptgewerk.Cells(8, 6) - Hauptgewerk.Cells(6, 6))
                Hauptgewerk.Cells(14, 6) = (Hauptgewerk.Cells(8, 6) - Hauptgewerk.Cells(7, 6)) / (Hauptgewerk.Cells(10, 6) - Hauptgewerk.Cells(6, 6))
            End If
 
        Next
 
Next
 '# Sucht das Blatt die von dem Hauptgewerk betrifft wird
For Each Feuille In Worksheets
    For Each C In HE.Range("B3:B" & HE.Cells(Rows.Count, 2).End(xlUp).Row)
           Hauptgewerk.Cells(5, 4).Value = C.Offset(0, 6).Value
           Hauptgewerk.Cells(5, 6).Value = Hauptgewerk.Cells(5, 4).Value + Hauptgewerk.Cells(5, 7).Value
        Next
Next
Next k
End Sub

J'ai pas tres bien ce que tu veux dire Ormonth.
La boucle sur le k est juste la pour changer le nom de la feuille dans laquelle je suhaite travailler..mais bon ca marche pas trop

Citation:

Envoyé par Potzo

:

J'ai pas tres bien ce que tu veux dire Ormonth.

dans ce code :

Code:

1
2
3
4
5
6
For Each Feuille In Worksheets
    For Each C In HE.Range("B3:B" & HE.Cells(Rows.Count, 2).End(xlUp).Row)
           Hauptgewerk.Cells(5, 4).Value = C.Offset(0, 6).Value
           Hauptgewerk.Cells(5, 6).Value = Hauptgewerk.Cells(5, 4).Value + Hauptgewerk.Cells(5, 7).Value
        Next
Next

écrire ainsi est bien plus lisible et montre que tu maîtrise tes boucles !

Code:

1
2
3
4
5
6
For Each Feuille In Worksheets
    For Each C In HE.Range("B3:B" & HE.Cells(Rows.Count, 2).End(xlUp).Row)
           Hauptgewerk.Cells(5, 4).Value = C.Offset(0, 6).Value
           Hauptgewerk.Cells(5, 6).Value = Hauptgewerk.Cells(5, 4).Value + Hauptgewerk.Cells(5, 7).Value
        Next C
Next Feuille

cordialement,

Didier

Et comme ça, ça donne quoi???

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
 
Sub feuilleErfüllung()
 
Dim C As Range
Dim Feuille As Worksheet, GESAMT As Worksheet, HE As Worksheet
Dim Such As String, Nom As String
 
Set GESAMT = Workbooks("Gesamt-Tabelle.xls").Worksheets("Tabelle")
Set HE = Workbooks("Versuch.xls").Worksheets("HE")
 
For k = 6 To Worksheets("Makros").Cells(Rows.Count, 8).End(xlUp).Row
    Nom = Worksheets("Makros").Cells(k, 8).Value
    Set Feuille = Worksheets(Nom)
 
' # Sucht die Zeile ins Gesamt Tabelle, wo es die feuilleergebnisse gibt.
    For Each C In GESAMT.Range("L8:L" & GESAMT.Cells(Rows.Count, 12).End(xlUp).Row)
        If C.Value = 2 And Feuille.Name = C.Offset(0, -11).Value Then
           ' Fügt eine neue Spalte für das Monat ein
            Feuille.Range("F1").EntireColumn.Insert
            Feuille.Range("D4") = GESAMT.Range("Z6").Value
            Feuille.Range("F4") = GESAMT.Range("Z6").Value
        '   # Erfüllt das Blatt
            Feuille.Range("B5:B11") = C.Offset(0, -11).Value
            Feuille.Cells(6, 6) = C.Offset(0, 8).Value + C.Offset(0, 7).Value
            Feuille.Cells(8, 6) = C.Offset(0, 2).Value
            Feuille.Cells(6, 4).Value = C.Offset(0, 17).Value + C.Offset(0, 16).Value
            Feuille.Cells(7, 6) = C.Offset(0, 14).Value * C.Offset(0, 2).Value
            Feuille.Cells(9, 6) = Feuille.Cells(6, 6) + (Feuille.Cells(8, 6) - Feuille.Cells(7, 6))
            Feuille.Cells(10, 6) = Feuille.Cells(6, 6) * Feuille.Cells(8, 6) / Feuille.Cells(7, 6)
            Feuille.Cells(11, 6) = Feuille.Cells(6, 6) + (Feuille.Cells(8, 6) - Feuille.Cells(7, 6)) * Feuille.Cells(5, 6) * Feuille.Cells(6, 6) / (Feuille.Cells(7, 6) * Feuille.Cells(7, 6))
            Feuille.Cells(12, 6) = Feuille.Cells(8, 6) - Feuille.Cells(11, 6)
            Feuille.Cells(13, 6) = (Feuille.Cells(8, 6) - Feuille.Cells(7, 6)) / (Feuille.Cells(8, 6) - Feuille.Cells(6, 6))
            Feuille.Cells(14, 6) = (Feuille.Cells(8, 6) - Feuille.Cells(7, 6)) / (Feuille.Cells(10, 6) - Feuille.Cells(6, 6))
        End If
    Next C
 '# Sucht das Blatt die von dem feuille betrifft wird
    For Each C In HE.Range("B3:B" & HE.Cells(Rows.Count, 2).End(xlUp).Row)
           Feuille.Cells(5, 4).Value = C.Offset(0, 6).Value
           Feuille.Cells(5, 6).Value = Feuille.Cells(5, 4).Value + Feuille.Cells(5, 7).Value
    Next C
Next k
 
End Sub

16/08/2010, 13h39
Potzo

Ca marche avec ton prgramme mayeukeul.

Merci beaucoup :)