Discussion :

[barrym78]

Bonjour le forum,

Je viens solliciter votre aide.

Mon classeur Excel est organisé de la manière suivante:
- Colonne 1: Nom des tâches
- Colonne 2: Date de début
- Colonne 3: Date de fin
- Colonne 4 : Code permettant de différencier les différentes tâches.

Mon but c'est d'ajouter des valeurs aux colonnes 2 et 3 de mes tâches en fonction du code qu'elles contiennent (colonne 4).

Je suis donc parti sur un Userform dans lequel je définis dans un Textbox la valeur que je souhaite ajouter à mes colonnes. Ci-dessous mon 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
35
36
37
38
39
40
41
42
43
44
45
Private Sub CommandButton3_Click()  'Bouton Valider
 
Dim S As Integer, derLig As Integer, i As Integer, f As Worksheet, a As Integer, b As Integer
 
    'modif_duree
    If TextBox1 = "" Then
        Exit Sub
    End If
 
    Set f = Sheets("Feuil1")
    With f
    DerniereLigne = Feuil1.Range("A300").End(xlUp).Address
    L = Range(DerniereLigne).Row
 
'Compte le nombre total de tâches avec le code Super
 
    For i = 2 To L
    S = WorksheetFunction.CountIf(.Range(.Cells(2, 4), .Cells(i, 4)), "Super")
 
    Next i
 
'Ajout des valeurs
 
    For i = 2 To L
 
    'Condition uniquement pour la première ligne de Super
    If S = 1 Then
    .Cells(i, 3) = .Cells(i, 3) + ((1 / (S * 3)) * Val(TextBox1))
 
 
    'Condition sur toutes les autres ligne de Super (de la 2èeme à la dernière)
    ElseIf S > 1 Then
                .Cells(i, 2) = .Cells(i, 2) + ((a - 1 / (S * 3)) * Val(TextBox1))
                .Cells(i, 3) = .Cells(i, 3) + ((a / (S * 3)) * Val(TextBox1))
    End If
 
    Next i
 
    End With
 
   Set f = Nothing
 
    TextBox1 = ""
repartition.Hide
End Sub

Le principe est le suivant:

1 - Compter le nombre total de tâches (ou lignes) portant le code Super dans la colonne 4
2 - Appliquer une première condition Uniquement sur la première tâche avec le code Super
2 - Appliquer une deuxième condition sur toutes les autres lignes (de la 2 ème à la dernière) portant le code Super.

La partie du code suivante me permet de déterminer à l'aide de la fonction CountIf le nombre total de lignes avec le code Super:

Code :

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

1
2
3
4
5
6
'Compte le nombre total de tâches avec le code Super
 
    For i = 2 To L
    S = WorksheetFunction.CountIf(.Range(.Cells(2, 4), .Cells(i, 4)), "Super")
 
    Next i

Mon problème vient dans la suite du code. Je n'arrive pas à trouver la bonne syntaxe pour définir ma variable a ni à appliquer les conditions Uniquement sur la première ligne de Super dans un premier temps puis sur toutes les autres lignes de Super dans un deuxième temps dans la partie suivante

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
For i = 2 To L
 
    'Condition uniquement pour la première ligne de Super
    If S = 1 Then
    .Cells(i, 3) = .Cells(i, 3) + ((1 / (S * 3)) * Val(TextBox1))
 
 
    'Condition sur toutes les autres ligne de Super (de la 2èeme à la dernière)
    ElseIf S > 1 Then
                .Cells(i, 2) = .Cells(i, 2) + ((a - 1 / (S * 3)) * Val(TextBox1))
                .Cells(i, 3) = .Cells(i, 3) + ((a / (S * 3)) * Val(TextBox1))
    End If
 
    Next i

Je voudrais ajouter dans la colonne 3 de la première ligne portant le code "Super" la valeur suivante:

Code :

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

+ ((1 / (S * 3)) * Val(TextBox1))

Avec S = le nombre total de ligne portant le code Super

Puis sur toutes les autres lignes toujours avec le code Super en colonne 4 (de la 2 ème à la dernière ligne), ajouter la valeur suivante:

-Dans la colonne 2 :

Code :

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

+ ((a - 1 / (S * 3)) * Val(TextBox1))

avec a -1 = le numéro de ligne Super précédent. Si on est à la troisième ligne de Super, a-1 = 2

-Dans la colonne 3 :

Code :

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

+ ((a / (S * 3)) * Val(TextBox1))

avec a = le numéro de ligne Super actuel Si on est à la troisième ligne de Super, a =3

Toujours avec S = le nombre total de lignes de Super.

Pouvez-vous m'orienter dans ma démarche?

Je vous remercie d'avance pour votre aide !

Ci-joint mon classeur Excel.

[Invité]

Bonjour,

Déjà, commençons par compter le nombre "Super" présent dans ta colonne :

Code :

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

1
2
3
4
5
6
7
Dim nbOccurence As Variant
Dim derLig As Integer
 
    'Récupère le nombre de ligne de ton fichier
    derLig = .Cells(Rows.Count, 4).End(xlUp).Row
    'Calcul le nombre de fois que "Super" est présent dans ta colonne
    nbOccurence = Evaluate("COUNTIF(D2:D" & derLig & ",""Super"")")

Ensuite, on va utiliser un Find pour trouver les lignes comprenant le mot "Super" en colonne 4 :

Code :

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

1
2
3
4
5
6
Dim r As Range
Dim f As WorkSheet
 
    With f
           'On récupère la première ligne comportant "Super"
           Set r = .Range("D2:D"  & derLig).Find("Super")

Ensuite, on applique ton calcul sur la première ligne trouvé et on passe à la ligne suivant (en gardant le numéro de la ligne précédente pour tes futurs calculs) :

Code :

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

1
2
3
4
5
6
7
8
9
10
Dim lignePrec As Integer
 
      'On applique ton calcul
     .Cells(r.Row, 3) = .Cells(r.Row, 3) + ((1 / (nbOccurence - 3)) - Val(TextBox1))
 
     'On garde en mémoire le numéro de la ligne
     lignePrec = r.Row
 
     'On passe à la ligne suivante
     Set r = .Range("D2:D" & derLig).FindNext(r)

Et enfin, on applique les autres calculs à toutes les autres lignes trouvés :

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
Dim address As String
 
If Not r Is Nothing Then
 
            'On garde en mémoire l'adresse de la ligne actuelle
            address = r.address
 
            Do
 
                'On applique tes calculs
                .Cells(r.Row, 2) = .Cells(r.Row, 2) + ((lignePrec / (nbOccurence * 3)) * Val(TextBox1))
                .Cells(r.Row, 3) = .Cells(r.Row, 3) + ((r.Row / (nbOccurence * 3)) * Val(TextBox1))
 
                'On récupère le numéro de la ligne actuel
                lignePrec = r.Row
                'On passe à la ligne suivante
                Set r = .Range("D2:D" & derLig).FindNext(r)
 
            'Et on fait ceci tant que l'on a des ligne a étudié ou tant que l'on est pas retourné à la première ligne étudiée
            Loop While Not r Is Nothing And r.address <> address
 
    End If

Voilà, avec ceci tu as toute les cartes en main pour résoudre ton problème, si tu as des question hésite pas.

[barrym78]

Bonjour Oudouner,

Merci beaucoup pour ton aide, j'ai complété ta macro en rajoutant "Feuil1" avant les

Code :

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

.Cells

et

Code :

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

.Range

afin qu'elle fonctionne sur mon classeur .

J'ai fait un test et la macro fonctionne très bien. Il y a juste un petit soucis:

- La macro commence à s’exécuter à partir de la ligne 4 de mon classeur (soit à la 2 ème tâche avec le code "Super") plutôt qu'à partir de la ligne 2 (première tâche avec le code super) comment y remédier?

J'ai également une deuxième question à te poser parce que je pense que je me suis un peu mal exprimé .

Est-il possible de remplacer

Code :

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

r.Row

par le numéro de Super actuel et

Code :

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

lignePrec

par le numéro de Super précédent dans la partie du code suivante?

Code :

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

1
2
+ ((lignePrec / (nbOccurence * 3)) * Val(TextBox1))
+ ((r.Row / (nbOccurence * 3)) * Val(TextBox1))

Par exemple dans cette illustration,



la ligne 2 contient la 1ère tâche super
la ligne 4 la 2ème tâche super
la ligne 6 la 3ème tâche super
etc...

Ainsi en prenant la ligne 8 de cet exemple, celle-ci contient la 4 ème tache de super, on aurait donc le code suivant:

Code :

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

1
2
.Cells(8, 2) = .Cells(8, 2) + (( 3 / (nbOccurence * 3)) * Val(TextBox1))
.Cells(8, 3) = .Cells(8, 3) + ((4 / (nbOccurence * 3)) * Val(TextBox1))

puis pour

Code :

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

lignePrec = r.Row

on aurait

Code :

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

lignePrec = 4

Je sais pas si j'ai été un peu plus clair.

Je te remercie d'avance

[Invité]

Si j'ai bien compris, essaye avec sa (à intégrer dans tout ton code bien sur) :

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
Public Sub barrym()
 
Dim S As Integer, derLig As Integer, i As Integer, f As Worksheet, a As Integer, r As Range, nbOccurence As Variant, address As String, lignePrec As Integer
 
    Set f = ActiveWorkbook.Sheets("Feuil1")
 
    With f
 
        derLig = .Cells(Rows.Count, 4).End(xlUp).Row
        nbOccurence = Evaluate("COUNTIF(D2:D" & derLig & ",""Super"")")
    'Compte le nombre total de tâches avec le code Super
 
        Set r = .Range("D1:D" & derLig).Find("Super")
 
        .Cells(r.Row, 3) = .Cells(r.Row, 3) + ((1 / (nbOccurence - 3)) - Val(TextBox1))
 
        lignePrec = 1
        Set r = .Range("D1:D" & derLig).FindNext(r)
 
         If Not r Is Nothing Then
 
                'On garde en mémoire l'adresse de la première ligne
                address = r.address
 
                Do
 
                    .Cells(r.Row, 2) = .Cells(r.Row, 2) + ((lignePrec / (nbOccurence * 3)) * Val(TextBox1))
                    .Cells(r.Row, 3) = .Cells(r.Row, 3) + ((lignePrec + 1 / (nbOccurence * 3)) * Val(TextBox1))
 
                    'On récupère le numéro de la ligne actuel
                    lignePrec = lignePrec + 1
                    'On passe à la ligne suivante
                    Set r = .Range("D1:D" & derLig).FindNext(r)
 
                'Et on fait ceci tant que l'on a des ligne a étudié ou tant que l'on est pas retourné à la première ligne étudiée
                Loop While Not r Is Nothing And r.address <> address
 
        End If
    End With
 
End Sub

[barrym78]

Parfait, c'est exactement ce qu'il me fallait, tu m'enlèves une épine du pied. Merci beaucoup !

Un dernier point, dans la deuxième partie de la 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
 Set r = f.Range("D1:D" & derLig).FindNext(r)
 
         If Not r Is Nothing Then
 
                'On garde en mémoire l'adresse de la première ligne
                address = r.address
 
                Do
 
                    f.Cells(r.Row, 2) = f.Cells(r.Row, 2) + ((lignePrec / (nbOccurence * 3)) * Val(TextBox1))
                    f.Cells(r.Row, 3) = f.Cells(r.Row, 3) + (((lignePrec + 1) / (nbOccurence * 3)) * Val(TextBox1))
 
                    'On récupère le numéro de la ligne actuel
                    lignePrec = lignePrec + 1
                    'On passe à la ligne suivante
                    Set r = f.Range("D1:D" & derLig).FindNext(r)
 
                'Et on fait ceci tant que l'on a des ligne a étudié ou tant que l'on est pas retourné à la première ligne étudiée
                Loop While Not r Is Nothing And r.address <> address
 
        End If

La boucle tourne jusqu'à revenir sur la première tâche Super et applique de nouveau l'ajout des valeurs. Peut-on rajouter une condition pour qu'une fois de retour sur la première ligne, qu'il n'y ait pas de nouvelle fois un ajout de valeur?

La première tâche Super est actuellement affectée dans un premier temps par:

Code :

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

1
2
3
4
5
Set r = f.Range("D1:D" & derLig).Find("Super")
 
 f.Cells(r.Row, 3) = f.Cells(r.Row, 3) + ((1 / (nbOccurence * 3)) * Val(TextBox1))
 
 lignePrec = 1

Puis un fin de macro lorsque la boucle revient à la première tache Super par:

Code :

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

1
2
f.Cells(r.Row, 2) = f.Cells(r.Row, 2) + ((lignePrec / (nbOccurence * 3)) * Val(TextBox1))
 f.Cells(r.Row, 3) = f.Cells(r.Row, 3) + (((lignePrec + 1) / (nbOccurence * 3)) * Val(TextBox1))

Hors logiquement avec :

Code :

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

Loop While Not r Is Nothing And r.address <> address

La macro est censée s'arrêter une fois de retour à la première tâche. (Elle s'arrête bien à la première tâche mais après avoir rajouté les valeurs).

[Invité]

Ah oui ! Excuse moi c'est une erreur de ma part, il faut conserver l'adresse de la première ligne avant de rencontrer dans le If !
De cette manière :

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
Public Sub barrym()
 
Dim S As Integer, derLig As Integer, i As Integer, f As Worksheet, a As Integer, r As Range, nbOccurence As Variant, address As String, lignePrec As Integer
 
    Set f = ActiveWorkbook.Sheets("Feuil1")
 
    With f
 
        derLig = .Cells(Rows.Count, 4).End(xlUp).Row
        nbOccurence = Evaluate("COUNTIF(D2:D" & derLig & ",""Super"")")
    'Compte le nombre total de tâches avec le code Super
 
        Set r = .Range("D1:D" & derLig).Find("Super")
 
        .Cells(r.Row, 3) = .Cells(r.Row, 3) + ((1 / (nbOccurence - 3)) - Val(TextBox1))
 
        lignePrec = 1
        address = r.address
        Set r = .Range("D1:D" & derLig).FindNext(r)
 
         If Not r Is Nothing Then
 
                'On garde en mémoire l'adresse de la première ligne
 
                Do
 
                    .Cells(r.Row, 2) = .Cells(r.Row, 2) + ((lignePrec / (nbOccurence * 3)) * Val(TextBox1))
                    .Cells(r.Row, 3) = .Cells(r.Row, 3) + ((lignePrec + 1 / (nbOccurence * 3)) * Val(TextBox1))
 
                    'On récupère le numéro de la ligne actuel
                    lignePrec = lignePrec + 1
                    'On passe à la ligne suivante
                    Set r = .Range("D1:D" & derLig).FindNext(r)
 
                'Et on fait ceci tant que l'on a des ligne a étudié ou tant que l'on est pas retourné à la première ligne étudiée
                Loop While Not r Is Nothing And r.address <> address
 
        End If
    End With
 
End Sub

[barrym78]

Parfait ça fonctionne, je te remercie beaucoup !

[barrym78]

Bonjour Oudouner,

Je reviens une nouvelle fois te demander de l'aide. J'ai voulu compléter la macro que tu m'as fourni (encore merci ) car le projet sur lequel je travaille a évolué.

La nouvelle trame, similaire à la première est organisée de la manière suivante:




Elle est composée de plusieurs parties (2 parties dans cet exemple).

Ces parties commencent toujours par la tâche "Gros oeuvre" en colonne A et se terminent par la tâche "Réception" toujours en colonne A.

L'idée est toujours la même:

1 - Compter le nombre de Super en colonne 4
2 - Ajouter des valeurs uniquement à la première tâche Super
3 - Ajouter des valeurs à toutes les autres tâches Super, de la 2ème à la dernière.

La seule différence est que je souhaiterais que la macro s'exécute indépendamment dans chaque partie.

L'idée serait que la macro s'exécute normalement dans la partie 1 de la tâche Gros oeuvre à la tâche Réception puis une fois à la tâche Réception ou à la deuxième tâche Gros oeuvre, qu'elle se réinitialise, qu'elle s'exécute sans prendre en compte les informations de la partie 1.

Ainsi dans la partie 1 la macro fonctionnerait avec 6 tâches de SUPER puis dans la partie 2 avec 4 tâches de SUPER.

La macro actuelle va compter le nombre de tâches SUPER sur tout le classeur, partie 1 et 2 comprises et donc fonctionnerait avec 10 tâches SUPER.

C'est l'idée que j'ai eu pour le moment, je ne sais pas si c'est possible. Si non, aurais-tu une idée pour m'orienter? Sachant que les parties composant le projet peuvent varier (2, 3, 4 5 etc...).

Merci d'avance.

[Invité]

Bonjour,

Voici mon idée, pose des question si besoin.

On commence en cherchant toute les lignes contenant "Réception" en colonne A.

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
Private Sub CommandButton3_Click()  'Bouton Valider
 
    'modif_duree
    If TextBox1 = "" Then
        Exit Sub
    End If
 
Dim S As Integer, derLig As Integer, i As Integer, f As Worksheet, a As Integer, r As Range, nbOccurence As Variant, address As String, lignePrec As Integer, r2 As Range, address2 As String, ligneRecep As Integer
 
    Set f = ActiveWorkbook.Sheets("Feuil1")
 
    With f
 
        'On récupère la dernière ligne du fichier
        derLig = f.Cells(Rows.Count, 4).End(xlUp).Row
        'On cherche les lignes contennant "Réception" en colonne A
        r2 = .Range("A1:A" & derLig).Find("Réception")
        'On indique que c'est la première ligne de réception
        ligneRecep = 1

Ensuite, on fait comme d'habitude pour chercher les "Super" mais, on limite notre recherche à la ligne où l'on a trouvé le premier "Réception". Bien sur, on applique ceci pour chaque ligne de "Réception" trouvé.

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
If Not r2 Is Nothing Then
 
            'On conserve en mémoire l'adresse de la première ligne trouvée
            address2 = r2.address
 
            Do
 
              'Compte le nombre total de tâches avec le code Super jusqu'à la ligne de Réception étudiée
               nbOccurence = Evaluate("COUNTIF(D" & ligneRecep + 1 & ":D" & r2.Row & ",""Super"")")
 
               'On cherche les lignes contenants "Super" dans la Partie 1 du fichier
               Set r = f.Range("D1:D" & r2.Row).Find("Super")
 
               f.Cells(r.Row, 3) = f.Cells(r.Row, 3) + ((1 / (nbOccurence * 3)) * Val(TextBox1))
 
               lignePrec = 1
 
 
              'On garde en mémoire l'adresse de la première ligne
               address = r.address
               Set r = f.Range("D1:D" & derLig).FindNext(r)
 
                If Not r Is Nothing Then
 
                       Do
 
                           f.Cells(r.Row, 2) = f.Cells(r.Row, 2) + ((lignePrec / (nbOccurence * 3)) * Val(TextBox1))
                           f.Cells(r.Row, 3) = f.Cells(r.Row, 3) + (((lignePrec + 1) / (nbOccurence * 3)) * Val(TextBox1))
 
                           'On récupère le numéro de la ligne actuel
                           lignePrec = lignePrec + 1
                           'On passe à la ligne suivante
                           Set r = f.Range("D1:D" & derLig).FindNext(r)
 
                       'Et on fait ceci tant que l'on a des ligne a étudié ou tant que l'on est pas retourné à la première ligne étudiée
                       Loop While Not r Is Nothing And r.address <> address
 
                End If
 
                'On garde en mémoire la dernière de la Partie 1 pour ne pas refaire les calculs dedans
                ligneRecep = r2.Row
                'On passe à la ligne suivant où il y a "Réception" en colonne A
                Set r2 = .Range("A1:A" & derLig).FindNext(r2)
 
           'Et on fait ceci jusqu'à qu'on n'est tout parcouru !
           Loop While Not r2 Is Nothing And r2.address <> address2
 
        End If

Voilà voilà, j'espère que tu as compris le fonctionnement.

[barrym78]

Re,

Merci beaucoup, j'ai fait un test et ça a l'air de bien fonctionner .

Il y a juste un petit bug à la dernière ligne :



On m'indique une Erreur d'exécution '91': Variable objet ou variable de bloc non définie.

J'ai modifié la partie suivante :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
 
        'On récupère la dernière ligne du fichier
        derLig = f.Cells(Rows.Count, 4).End(xlUp).Row
        'On cherche les lignes contennant "Réception" en colonne A
        Set r2 = f.Range("A1:A" & derLig).Find("Réception")
        'On indique que c'est la première ligne de réception
        ligneRecep = 1
 
 
 
        If Not r2 Is Nothing Then
 
            'On conserve en mémoire l'adresse de la première ligne trouvée
            address2 = r2.address

Par

Code :

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

1
2
3
4
5
6
7
8
9
10
11
'On récupère la dernière ligne du fichier
        derLig = f.Cells(Rows.Count, 4).End(xlUp).Row
        'On cherche les lignes contennant "Réception" en colonne A
        Set r2 = f.Range("A1:A" & derLig).Find("Réception")
        'On indique que c'est la première ligne de réception
        ligneRecep = 1
 
         'On conserve en mémoire l'adresse de la première ligne trouvée
            address2 = r2.address
 
        If Not r2 Is Nothing Then

En conservant l'adresse avant le If mais ça me redonne la même erreur.

Sais-tu d'où ça pourrait venir?

[barrym78]

En fait la macro n'arrive pas à définir la variable r2:



J'ai relancé la macro et on remarque que dès la première ligne elle indique que r2 = nothing. Pourtant r2 est censé indiquer Réception et surtout l'ajout des valeurs se fait correctement il me semble

[Invité]

Oui, j'ai fait plusieurs test aussi et le Find ne trouve pas le deuxième "Réception", j'ai essayé plusieurs choses mais je ne trouve pas la solution, je vais continuer de chercher.

J'ai aussi remarqué que mon code ne faisait pas les calculs correctement, c'est mieux comme sa :

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
Private Sub CommandButton3_Click()  'Bouton Valider
 
    'modif_duree
    If TextBox1 = "" Then
        Exit Sub
    End If
 
Dim S As Integer, derLig As Integer, i As Integer, f As Worksheet, a As Integer, r As Range, nbOccurence As Variant, address As String, lignePrec As Integer, r2 As Range, address2 As String, ligneRecep As Integer
 
    Set f = ActiveWorkbook.Sheets("Feuil1")
 
    With f
 
        derLig = f.Cells(Rows.Count, 4).End(xlUp).Row
        Set r2 = f.Range("A1:A" & derLig + 1).Find("Réception")
        ligneRecep = 1
 
        If Not r2 Is Nothing Then
 
            address2 = r2.address
 
            Do
 
              'Compte le nombre total de tâches avec le code Super
               nbOccurence = Evaluate("COUNTIF(D" & ligneRecep + 1 & ":D" & r2.Row & ",""Super"")")
 
               Set r = f.Range("D" & ligneRecep + 1 & ":D" & r2.Row + 1).Find("Super")
 
               f.Cells(r.Row, 3) = f.Cells(r.Row, 3) + ((1 / (nbOccurence * 3)) * Val(TextBox1))
 
               lignePrec = 1
 
 
              'On garde en mémoire l'adresse de la première ligne
               address = r.address
               Set r = f.Range("D" & ligneRecep + 1 & ":D" & r2.Row + 1).FindNext(r)
 
                If Not r Is Nothing Then
 
                       Do
 
                           f.Cells(r.Row, 2) = f.Cells(r.Row, 2) + ((lignePrec / (nbOccurence * 3)) * Val(TextBox1))
                           f.Cells(r.Row, 3) = f.Cells(r.Row, 3) + (((lignePrec + 1) / (nbOccurence * 3)) * Val(TextBox1))
 
                           'On récupère le numéro de la ligne actuel
                           lignePrec = lignePrec + 1
                           'On passe à la ligne suivante
                           Set r = f.Range("D" & ligneRecep + 1 & ":D" & r2.Row + 1).FindNext(r)
 
                       'Et on fait ceci tant que l'on a des ligne a étudié ou tant que l'on est pas retourné à la première ligne étudiée
                       Loop While Not r Is Nothing And r.address <> address
 
                End If
 
                ligneRecep = r2.Row
                Set r2 = f.Range("A1:A" & derLig + 1).FindNext(r2)
 
           Loop While Not r2 Is Nothing And r2.address <> address2
 
        End If
 
    End With
 
 
    TextBox1 = ""
repartition.Hide
End Sub

[barrym78]

Ok merci, je vais aussi voir de mon côté si j'ai des illuminations

[Invité]

J'ai ouvert une discussion (https://www.developpez.net/forums/d1...t/#post9449149) pour demander de l'aide sur le FindNext (le problème vient surement de là), j'ai exposé un sujet différent que le tien mais avec le même problème, je te laisse voir.

[barrym78]

Ah super, merci de ton aide

[Invité]

Bonjour barrym,

Voici une solution qui marche de mon côté !
L'idée vient de patricktoulon qui a fait un super travail et que je remercie de son aide !

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
Sub Macro1()
 
    Dim plage As Range
    Dim tablo_ligne() As String
    Dim i As Integer
    Dim nbOccurence As Variant
    Dim ligne As Integer
 
    With ActiveSheet
 
        With .Range(.Cells(2, 1), .Cells(Rows.Count, 1).End(xlUp))
 
            .AutoFilter Field:=1, Criteria1:="=Gros oeuvre", Operator:=xlOr, Criteria2:="=Réception"
            Set plage = .SpecialCells(xlVisible)
            .AutoFilter
 
        End With
 
    End With
 
    'MsgBox plage.address
 
    tablo_ligne = Split(Replace(plage.address, ":", ","), ",")
 
    For i = 0 To UBound(tablo_ligne) - 1 Step 2
 
        nbOccurence = Evaluate("COUNTIF(D" & Split(tablo_ligne(i), "$")(2) & ":D" & Split(tablo_ligne(i + 1), "$")(2) & ",""Super"")")
 
        For Each cel In Range(tablo_ligne(i) & ":" & tablo_ligne(i + 1))
 
            ligne = 1
 
            If cel.Offset(0, 3) = "Super" Then
 
                If ligne = 1 Then
 
                    cel.Offset(0, 2) = cel.Offset(0, 2) + ((1 / (nbOccurence * 3)) * Val(TextBox1))
                    ligne = 2
 
                Else
 
                    cel.Offset(0, 2) = cel.Offset(0, 2) + ((cel.Row / (nbOccurence * 3)) * Val(TextBox1))
                    cel.Offset(0, 1) = cel.Offset(0, 1) + ((cel.Row - 1 / (nbOccurence * 3)) * Val(TextBox1))
 
                End If
 
            End If
 
        Next
 
    Next
 
End Sub

[barrym78]

Bonjour Oudouner,

J'espère que ton opération s'est bien passée .

Merci pour la macro (merci à patricktoulon et à parmi également ). J’essayais aussi d'adapter leurs solutions à mon problème mais je n'avais pas encore réussi.

La macro fonctionne plutôt bien, mais je crois qu'elle ne prend pas en compte cette partie du code:

Code :

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

1
2
3
4
Else
 
cel.Offset(0, 2) = cel.Offset(0, 2) + ((cel.Row / (nbOccurence * 3)) * Val(TextBox1))
cel.Offset(0, 1) = cel.Offset(0, 1) + ((cel.Row - 1 / (nbOccurence * 3)) * Val(TextBox1))

Les valeurs sont ajoutées uniquement à la colonne 3 du classeur en prenant tout le temps cell.Row =1.

j'ai ajouté Dim cel as Variant en début de la macro car on m'affichait comme erreur "variable non définie" mais je ne pense pas que ça vienne de là.

As-tu le même problème de ton côté ou ça vient juste de mon classeur? ^^

[Invité]

L'opération s'est très bien passé.

J'ai fait une petite erreur, il ne faut pas initialiser "ligne = 1" dans le for each mais le mettre dans le for i :

Code :

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

1
2
3
4
5
6
  For i = 0 To UBound(tablo_ligne) - 1 Step 2
 
        ligne = 1
        nbOccurence = Evaluate("COUNTIF(D" & Split(tablo_ligne(i), "$")(2) & ":D" & Split(tablo_ligne(i + 1), "$")(2) & ",""Super"")")
 
        For Each cel In Range(tablo_ligne(i) & ":" & tablo_ligne(i + 1))

[barrym78]

ah tant mieux alors .

Le bug de tout à l'heure a été résolu mais le résultat obtenu dans les calculs n'est pas le bon.
On obtient


Alors que je résultat voulu est:


Du coup je me demandais à quoi correspond Cel.Row et Cel.Row -1? J'ai essayer de lancer la macro manuellement en mettant des "pauses" pour voir la valeur récupérer par la macro mais ça ne marche pas. Je pense que le problème provient peut-être de la-bas ^^.

je sais pas si tu te rappelle mais dans la première macro que tu m'avais fournie et que fonctionnait très bien on avait appliqué la condition:


Pour que lignePrec = 1 pour la première tâche de super et on augmentait cette valeur au fur et à mesure des tâches super rencontrées pour que le résultat obtenu soit le bon.

[Invité]

J'ai encore du mal ce matin, j'ai exactement fait la même erreur que dans mon premier post .

On va y arriver :

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
Sub Macro1()
 
    Dim plage As Range
    Dim tablo_ligne() As String
    Dim i As Integer
    Dim nbOccurence As Variant
    Dim ligne As Integer
 
    With ActiveSheet
 
        With .Range(.Cells(2, 1), .Cells(Rows.Count, 1).End(xlUp))
 
            .AutoFilter Field:=1, Criteria1:="=Gros oeuvre", Operator:=xlOr, Criteria2:="=Réception"
            Set plage = .SpecialCells(xlVisible)
            .AutoFilter
 
        End With
 
    End With
 
    'MsgBox plage.address
 
    tablo_ligne = Split(Replace(plage.address, ":", ","), ",")
 
    For i = 0 To UBound(tablo_ligne) - 1 Step 2
 
        ligne = 1
        nbOccurence = Evaluate("COUNTIF(D" & Split(tablo_ligne(i), "$")(2) & ":D" & Split(tablo_ligne(i + 1), "$")(2) & ",""Super"")")
 
        For Each cel In Range(tablo_ligne(i) & ":" & tablo_ligne(i + 1))
 
            If cel.Offset(0, 3) = "Super" Then
 
                If ligne = 1 Then
 
                    cel.Offset(0, 2) = cel.Offset(0, 2) + ((1 / (nbOccurence * 3)) * Val(TextBox1))
                    ligne = ligne + 1
 
                Else
 
                    cel.Offset(0, 2) = cel.Offset(0, 2) + ((ligne / (nbOccurence * 3)) * Val(TextBox1))
                    cel.Offset(0, 1) = cel.Offset(0, 1) + ((ligne - 1 / (nbOccurence * 3)) * Val(TextBox1))
                    ligne = ligne + 1
 
                End If
 
            End If
 
        Next
 
    Next
 
End Sub