Syntaxe variables avec CountIf

Version imprimable

1 pièce(s) jointe(s)

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:

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:

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:

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:

+ ((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:

+ ((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:

+ ((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.

Bonjour,

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

Code:

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:

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:

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:

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. :)

11/07/2017, 11h48
barrym78

1 pièce(s) jointe(s)
Bonjour Oudouner,

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

Code:

.Cells

et

Code:

.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:

r.Row

par le numéro de Super actuel et

Code:

lignePrec

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

1 2 + ((lignePrec / (nbOccurence * 3)) * Val(TextBox1)) + ((r.Row / (nbOccurence * 3)) * Val(TextBox1))
Par exemple dans cette illustration,

Pièce jointe 293076

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:

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:

lignePrec = r.Row

on aurait

Code:

lignePrec = 4

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

Je te remercie d'avance

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

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
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

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:

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:

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:

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:

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).

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:

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

11/07/2017, 14h20
barrym78

Parfait ça fonctionne, je te remercie beaucoup ;) !
12/07/2017, 10h07
barrym78

2 pièce(s) jointe(s)

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:

Pièce jointe 293366

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.

Bonjour,

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

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

Code:

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:

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. 8-)

1 pièce(s) jointe(s)

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 :

Pièce jointe 293403

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:

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:

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?

12/07/2017, 11h46
barrym78

1 pièce(s) jointe(s)

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

Pièce jointe 293426

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 :roll:

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:

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

12/07/2017, 13h36
barrym78

Ok merci, je vais aussi voir de mon côté si j'ai des illuminations :D
12/07/2017, 13h50
Invité

J'ai ouvert une discussion (https://www.developpez.net/forums/d1...t/) 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. :)
12/07/2017, 14h08
barrym78

Ah super, merci de ton aide ;)

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 ! :mrgreen:

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
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

17/07/2017, 10h33
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:

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? ^^

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:

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))

17/07/2017, 11h44
barrym78

3 pièce(s) jointe(s)

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
Pièce jointe 294611

Alors que je résultat voulu est:
Pièce jointe 294613

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:
Pièce jointe 294616

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.

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

On va y arriver :P :

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
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

17/07/2017, 12h02
barrym78

Haha pas de soucis !

Je viens de refaire un test et ça marche comme sur des roulettes !!!

Franchement merci beaucoup de ton aide, jy serais jamais arrivé sans toi :D

Re Oudouner,

Pour revenir sur le problème du FindNext, j'ai trouvé la solution:

A la fin de la macro, il faut remplacer
Code:

1 2 3 Set r2 = f.Range("A1:A" & derLig + 1).FindNext(r2) Loop While Not r2 Is Nothing And r2.address <> address2
Par:
Code:

1 2 3 If ligneRecep >= derLig Then Exit Sub ' termine la macro Set r2 = .Range("A" & ligneRecep & ":A" & derLig + 1 - 1).Find(r2) Loop
ça a l'air de fonctionner ;)