Etirer une "fonction perso"

**Nykky21** · 25/03/2016, 10h02

Bonjour à tous.

J'ai créé une fonction personnelle qui fonctionne correctement. Je ne dis pas qu'elle est parfaite, et mériterai surement d'être "racourci" mais elle fait bien ce que je lui demande.

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
Function livraison_doc(ByRef cellules_quantite As Range, ByRef cellules_annee As Range, ByRef continue As Byte, ByRef quantite_liv As Byte) As Integer
 
Dim cellule_quantite As Range
Dim cellule_annee As Range
Dim nb_mois As Integer
Dim q_liv As Integer
Dim colonne_start As Integer
Dim colonne As Integer
 
For Each cellule_annee In cellules_annee
    If colonne_start = 0 Then colonne_start = cellule_annee.Column - 1
    colonne = cellule_annee.Column - colonne_start
    If cellules_quantite.Cells(1, colonne) <> "" And cellules_annee.Cells(0, colonne) = Year(Cells(7, Selection.Column)) Then
        nb_mois = Round(cellules_quantite.Cells(1, colonne) / quantite_liv, 0)
        Select Case continue
        Case 1
            If Month(Cells(7, Selection.Column)) = 12 - nb_mois + 1 Then
                q_liv = cellules_quantite.Cells(1, colonne) - quantite_liv * (nb_mois - 1)
                livraison_doc = q_mun
            ElseIf Month(Cells(7, Selection.Column)) > 12 - nb_mois + 1 Then
                q_liv = quantite_liv
                livraison_doc = q_liv
            Else
                livraison_doc = 0
            End If
            Exit Function
        Case 2
            If Month(Cells(7, Selection.Column)) = nb_mois Then
                q_liv = cellules_quantite.Cells(1, colonne) - quantite_liv * (nb_mois - 1)
                livraison_doc = q_liv
            ElseIf Month(Cells(7, Selection.Column)) < nb_mois Then
                q_liv = quantite_liv
                livraison_doc = q_liv
            Else
                livraison_doc = 0
            End If
            Exit Function
        End Select
    End If
Next
 
End Function

Mon seul souci est que lorsque j' "étire" la fonction sur toutes mes cellules, je me retrouve avec le résultat de la cellule précédente et non un nouveau résultat.
ex : en janvier 2018, je dois avoir "0" et en avril 2018, j'ai comme résultat 4 quand je fais "entrer" cellule par cellule.
Si je tire de janvier 2018 à avril 2018, j'aurai "0" dans toutes les cellules de la plage.

Comment est ce que je peux faire pour pallier à ce petit souci ?

je vous remercie par avance,

Nykky

**kiki29** · 25/03/2016, 10h40

Salut, toujours bon de consulter : Les fonctions personnelles dans Excel.

mais elle fait bien ce que je lui demande.

. La preuve que non.

P.-S. : Balise ton code

**Nykky21** · 25/03/2016, 11h14

Bonjour,

Merci pour votre réponse. Je prends le temps de lire le document que vous avez mis en lien.
Je suis un peu têtue mais la macro fait bien ce que je veux. Le souci, c'est que je ne veux pas passer par une macro pour l'attribuer à chaque cellule.
Comme je ne suis pas la seule à utiliser le pgrm, il faut qu'une autre personne (ne sachant pas forcément coder) puisse l'utiliser sans souci, et donc puisse, comme la fonction "somme" d'excel, étirer la cellule sur une plage et donc que la formule se dublique et s'actualise.

Donc sur ma feuille excel, si la cellule

Code :

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

F8 =livraison_munition_doc('33. Commande&livraison_DOC'!$D$4:$I$4;'33

.

Code :

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

Commande&livraison_DOC'!$D$2:$I$2;$E$3;$E$2)

le résultat est 0 (Janvier 2017),
comme la "function" prend en compte de l'emplacement sélection (par selection.row et selection.column) qui est mon changement de variable, la cellule

Code :

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

AL8 =livraison_munition_doc('33. Commande&livraison_DOC'!$D$4:$I$4;'33

.

Code :

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

Commande&livraison_DOC'!$D$2:$I$2;$E$3;$E$2)

a pour résultat 7 (septembre 2019). Ces deux résultats apparaissent quand je valide (appuyez sur "entrer") dans chaque cellule. Mais si j'étire ma cellule F8 jusqu'à AL8, le résultat reste le même... soit 0. C'est plus dans l'actualisation de la formule que j'ai souci...

Cordialement,

Nykky

**eriiic** · 25/03/2016, 15h43

Bonjour,

ta fonction fait peut-être ce que tu veux mais tu as dedans une variable q_mun sortie ex-nihilo dont on n'est pas sûr au vu de l'extrait.

Selection.Column
Comment peux-tu être sûre de la sélection au moment de l'évaluation ???
Si tu veux la ref de la cellule en cours d'évaluation c'est ThisCell

eric

**Nykky21** · 25/03/2016, 15h54

Bonjour,

Merci pour votre réponse.
J'ai voulu jouer mes agents secret en modifiant certaines variables qui me parlent (étant lié à mon travail) par d'autre plus neutre (comme le q_liv) mais semblerai que je ne sois pas encore suffisament douée pour être un 007... le q_mun est en fait un q_val.
Finalement, en rajoutant un paramètre supplémentaire, la fonction a bien voulu fonctionnée.
Je vais quand même la tester avec le "Thiscell".
J'ai pris le temps de faire la fonction pas à pas, et elle voulait bien fonctionner. Mais si je l'étire comme dans la version que je vous ai mis en premier, elle ne fait que reproduire le chiffre précédent...
Ci dessous la nouvelle version :

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
Function livraison_doc(ByRef cellules_quantite As Range, ByRef cellules_annee As Range, ByRef continue As Integer, ByRef quantite_mun As Byte, ByRef donnée_date As Variant) As Integer
 
Dim cellule_quantite As Range
Dim cellule_annee As Range
Dim nb_mois As Integer
Dim q_mun As Integer
Dim colonne_start As Integer
Dim colonne As Integer
Dim nb_annee As Byte
Dim temp_annee As Byte
 
Application.ScreenUpdating = False
 
For Each cellule_annee In cellules_annee
    If colonne_start = 0 Then colonne_start = cellule_annee.Column - 1
    colonne = cellule_annee.Column - colonne_start
    If Val(cellules_quantite.Cells(1, colonne)) <> 0 Then nb_annee = nb_annee + 1
Next
 
For Each cellule_annee In cellules_annee
    colonne = cellule_annee.Column - colonne_start
    If cellules_quantite.Cells(1, colonne) <> "" Then
        temp_annee = temp_annee + 1
        If cellules_annee.Cells(1, colonne) = Year(donnée_date) Then
            nb_mois = WorksheetFunction.RoundUp(cellules_quantite.Cells(1, colonne) / quantite_mun, 0)
            Select Case continue
            Case 1
                If temp_annee = 1 Then
                    If Month(donnée_date) = 12 - nb_mois + 1 Then
                        q_liv = cellules_quantite.Cells(1, colonne) - quantite_liv * (nb_mois - 1)
                        livraison_doc = q_mun
                    ElseIf Month(donnée_date) > 12 - nb_mois + 1 Then
                        q_liv = quantite_liv
                        livraison_doc = q_liv
                    Else
                        livraison_doc = 0
                    End If
                Else: GoTo cas_2
                End If
                Application.ScreenUpdating = True
                Exit Function
            Case -1
cas_2:
                If Month(donnée_date) = nb_mois Then
                    q_liv = cellules_quantite.Cells(1, colonne) - quantite_liv * (nb_mois - 1)
                    livraison_doc = q_mun
                ElseIf Month(donnée_date) < nb_mois Then
                    q_liv = quantite_liv
                    livraison_doc = q_liv
                Else
                    livraison_doc = 0
                End If
                Exit Function
            End Select
        End If
    End If
Next
 
 
 
End Function

Si vous avez une explication du pk la première version n'a pas voulu fonctionner, je suis preneuse. Mon rajout majeur a été donnée_date qui est en fait un cellule juste au dessus où j'applique ma fonction perso.
Merci par avance,

Nykky