Discussion :

[rogerlette]

Bonjour à tous,


Débutant en VBA, je cherche à créer une formule que je rentre dans une cellule du style : =maformule(A1)

Et cette formule ferai la somme du premier groupe de case adjacentes pleines qui se trouve au dessus d'elle dans sa colonne.

J'ai pensé à CurrentRegion, j'ai essayé dans un premier temps de compter le nombre de lignes d'un groupe de cellules pleines avec une macro de ce type lancée par CTRL+G:

Code :

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

1
2
3
4
5
6
7
Sub Macro2()
 
' Touche de raccourci du clavier: Ctrl+g
 
    MsgBox Range("A2").CurrentRegion.Rows.Count
 
End Sub

Ca marche sans pb mais après quand j'ai voulue faire une fonction comme ceci :

Code :

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

1
2
3
4
5
6
7
Function nbrlignes(Cellule As Range) As Integer
 
 
    nbrlignes =  Cellule.CurrentRegion.Rows.Count
 
 
End Function

Et bien ca marche plus..

Pour testé j'ai essayé aussi de mettre dans ma fonction :

Code :

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

MsgBox Range("A2").CurrentRegion.Rows.Count

Mais c pareil même çà ca me donne pas le même résultat que le code qui marche.


Cà doit être stupide comme question car même en fouillant sur google je trouve pas de réponse, mais comment faut-il faire? .

Merci de votre aide

[mayekeul]

bonjour,

ce qui en marche pas, c'est quoi exactement?

la réponse est érronnée ou un message d'erreur apparait?

[rogerlette]

Merci de votre réponse,

Excusez moi je n'ai pas été très précis c'est vrai,

Alors en fait ce qui ne marche pas c'est que au lieu de m'afficher le nombre de lignes que contient le tableau trouvé pas la fonction CurrentRegion en fonction de la cellule choisie, il m'affiche toujours la valeur 1.

Et comme je suis pas le roi des explications au besoin voici un exemple :

http://dl.free.fr/rGaqPAwkP

[delphine35]

Chez moi, ca fontionne :

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
Function nbrlignes(Cellule As Range) As Integer
 
 
    nbrlignes = Cellule.CurrentRegion.Rows.Count
 
 
End Function
 
 
Sub main()
 
    toto = nbrlignes(Range("A2"))
    MsgBox (toto)
 
End Sub

[rogerlette]

J'ai copié collé ton code dans ma un module, effectivement la MsgBox affiche bien la bonne valeur mais lorsque dans une cellule j'écris :

Code :

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

=nbrlignes(A2)

Et bien la valeur de la cellule n'est pas la même que la valeur de la MsgBox.

Cherchez pas bien loin, ce doit être une erreur de débutant qui n'a pas bien compris le fonctionnement du VBA (Car c mon cas..)

Merci de votre aide.

[delphine35]

J'ai regarder, effectivement
On recupere bien la cellule mais il ne fait aucune action sur la feuille

J'ai essayé de mettre

Code :

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

   Range("A2").Select

Mais meme ca il le fait pas ....

[mercatog]

Une proposition approximative et tordue (en fait elle prend en compte les cellules adjacentes non vides de la colonne)

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
Public Function nbrlignes(Cellule As Range) As Long
Dim Deb As Range, Fin As Range
Application.Volatile
If Cellule <> "" Then
    If Cellule.Row < Rows.Count Then
        Set Fin = IIf(Cellule.Offset(1, 0) = "", Cellule, Cellule.End(xlDown))
    Else
        Set Fin = Cellule
    End If
    If Fin.Row > 1 Then
        Set Deb = IIf(Fin.Offset(-1, 0) = "", Fin, Fin.End(xlUp))
    Else
        Set Deb = Cellule
    End If
    nbrlignes = Fin.Row - Deb.Row + 1
    Set Deb = Nothing
    Set Fin = Nothing
Else
    nbrlignes = 0
End If
End Function

[rogerlette]

Eh eh merci à tous,


Et merci pour cette "proposition approximative" qui marche parfaitement !
Je me demande à quoi ressemble une réponse "Complète" !!!

Je vais essayer de comprendre tout ça pour faire la suite.

[mercatog]

Approximative du fait qu'elle ne répond pas à la définition de CurrentRegion

[rogerlette]

Re-bonjour,

J'enlève le résolu car malgré mes essais je peine.

Alors pour faire clair, ce que je veux faire:

- J'ai une cellule qui appelle la fonction : sstotal()
- Je veux détecter la première cellule pleine au dessus
- A partir de cette "cellule"; compter le nombre de cellules pleines au dessus (Résolu précédemment)
- Faire la somme de ce groupes de cellules pleines (Résolu aussi)
- Et afficher le résultat dans la cellule qui appel la fonction ; =sstotal()

Ce qui ne marche pas :
- En premier lieu je test avec "cellule" défini comme la deuxième cellule au dessus de celle qui appel la fonction. Je comprend pas pourquoi la fonction de comptage et de somme ne marche plus , alors que ma Msgbox affiche bien la valeur de la deuxième cellule au dessus...
- Et deuxièmement je comprend pas pourquoi ma fonction de recherche de la première cellule pleine ne marche pas.

Voici le code commenté, (comme vous pouvez le voir sur les posts précédent j'ai pas rajouté grand chose mais ca m'a pris du temps)
Je vous joins le fichier au besoin ou si je me suis mal exprimé.

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
Public Function sstotal() As Double
 
'récupère nom de la feuille - je sais pas à quoi ca sert dans mon cas mais c un code que j'ai trouvé sur le net
x = Application.Caller.Parent.Name
'récupère le nom de la cellule qui appel la fonction "sstotal"
y = Application.Caller.Address
'Définit "Cellule" comme la cellule se trouvant deux cellules au dessus de la cellule qui appel la fonction (même colonne)
Cellule = Range(y).Offset(-2, 0)
 
MsgBox Cellule
 
'Essai de code pour que "Cellule" soit la première cellule plein au dessus de la cellule qui appel la fonction -- marche pas...
'Dowhile Cellule = ""
'Cellule = Cellule.Offset(-1, 0)
'MsgBox Cellule
'Loop
 
'Compte le nombre de ligne du groupe de cellules adjacentes pleines au dessus de "Cellule"
'Marche parfaitement gràce à votre aide mais marche avec "Cellule" définie comme ci-dessus !
Dim Deb As Range
Dim Fin As Range
 
Application.Volatile
If Cellule <> "" And Cellule.Row < Rows.Count Then
    Set Fin = IIf(Cellule.End(xlDown).Row = Rows.Count Or Cellule.Offset(1, 0) = "", Cellule, Cellule.End(xlDown))
    If Fin.Row > 1 Then
        Set Deb = IIf(Fin.Offset(-1, 0) = "", Fin, Fin.End(xlUp))
    Else
        Set Deb = Cellule
    End If
    nbrlignes = Fin.Row - Deb.Row + 1
 
    Set Deb = Nothing
    Set Fin = Nothing
Else
    nbrlignes = 0
End If
 
'Fait la somme du groupe de cellules adjacentes pleines au dessus de "Cellule"
sstotal = Application.WorksheetFunction.Sum(Range(Cellule, Cellule.Offset(-nbrlignes, 0)))
 
End Function

http://dl.free.fr/danoTOozE

Merci beaucoup d'avance sincèrement

[mayekeul]

bonjour,

si j'ai bien compris ton problemes

voici une ébauche de solution

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
 
Public Function sstotal() As Double
Dim StartCellRow, EndCellRow, ThisColumn, I
 
'mettre le numéro de collone courante dans une variable
ThisColumn = Application.Caller.Column
 
'initialiser variable I
I = -1
 
'trouver la premiere cellule non vide au dessus de la cellule courante et récuperer le numero de ligne
Do Until StartCellRow > 0
    If Application.Caller.Offset(I, 0) <> "" Then StartCellRow = Application.Caller.Offset(I, 0).Row
    I = I - 1
Loop
 
'identifier la dernière celule adjacente pleine au dessus de la cellule précedente trouvée et récupérer le numéro de ligne
Do Until EndCellRow > 0
    If Application.Caller.Offset(I, 0) = "" Then EndCellRow = Application.Caller.Offset(I + 1, 0).Row
    I = I - 1
Loop
 
 
'Fait la somme du groupe de cellules adjacentes pleines au dessus de "Cellule"
sstotal = Application.WorksheetFunction.Sum(Range(Cells(StartCellRow, ThisColumn), Cells(EndCellRow, ThisColumn)))
 
End Function

[rogerlette]

J'allais écrire une solution à mon pb, très fier d'avoir trouvé mon erreur tout seul comme un grand et là ! BIMMM !!!

En trois lignes tu me pond une solution, tu me fais réaliser que c'est mon entêtement dans mon idée de départ (utilisation du CurentRegion) qui à fait qu'a final j'ai pataugé sur un truc simple.. bref LA leçon.

Et bien je dis merci tout de même ! C'est beaucoup plus propre au moins.

Je donne quand même l'erreur qu'il y avais dans mon code précédent si jamais ca intéresse quelqu'un d'aussi tétu que moi dans ses idées :

En fait c'étais la façon de déclarer et surtout d'affecter une valeur à ma variable cellule.
Il fallait la déclarer comme Range (ça j'avais déjà essayé mais seulement ça, ça ne marchais pas non plus)
Il fallait visiblement mettre "Set":
Set cellule = Range(y).Offset(-1, 0)
et pas juste :
cellule = Range(y).Offset(-1, 0)
Sinon ça récupère seulement la valeur ... voilà c peu être évident pour tous le monde mais moi j'ai mis 2h à trouver ç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
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
Public Function sstotal() As Double
 
'récupère le nom de la cellule qui appel la fonction "sstotal"
y = Application.ThisCell.Address
'Définit "Cellule" comme la cellule se trouvant deux cellules au dessus de la cellule qui appel la fonction (même colonne)
Dim cellule As Range
Set cellule = Range(y).Offset(-1, 0)
 
 
'"Cellule" est définie comme la première cellule pleine au dessus de la cellule qui appel la fonction -- marche pas...
Do While cellule = ""
    Set cellule = cellule.Offset(-1, 0)
Loop
 
 
'''Compte le nombre de ligne du groupe de cellules adjacentes pleines au dessus de "Cellule"
'''Marche parfaitement gràce à votre aide mais marche avec "Cellule" définie comme ci-dessus !
Dim Deb As Range
Dim Fin As Range
 
Application.Volatile
If cellule <> "" And cellule.Row < Rows.Count Then
    Set Fin = IIf(cellule.End(xlDown).Row = Rows.Count Or cellule.Offset(1, 0) = "", cellule, cellule.End(xlDown))
    If Fin.Row > 1 Then
        Set Deb = IIf(Fin.Offset(-1, 0) = "", Fin, Fin.End(xlUp))
    Else
        Set Deb = cellule
    End If
    nbrlignes = Fin.Row - Deb.Row + 1
 
    Set Deb = Nothing
    Set Fin = Nothing
Else
    nbrlignes = 0
End If
 
'Fait la somme du groupe de cellules adjacentes pleines au dessus de "Cellule"
sstotal = Application.WorksheetFunction.Sum(Range(cellule, cellule.Offset(-nbrlignes, 0)))
 
End Function