OVH Cloud OVH Cloud

Créer une fonction qui renvoye une liste de valeur

18 réponses
Avatar
[___FreGoLi___]
Bonjour,

Je désire ecrire une fonction qui renvoie la liste des valeurs différentes
d'une plage de cellules. (fonction complémentaire à nb.diff)

Pour le contenu de la fonction, je n'ai pas trop de problème d'algo, mais je
n'arrive pas à renvoyer une série de valeur, et que celle ci remplisse les
cellules.
Exemple de fonction:


Public Function Liste01() As Variant()

Dim Res() As Variant

ReDim Res(1)
Res(0) = "BC01"
ReDim Preserve Res(2)
Res(1) = "BC32"
ListeDiff = Res

End Function

Donc ici, je voudrai qu'elle fonctionne de manière analogue à DROITEREG qui
affecte une matrice en sortie.
Cette fonction "marche" (il n'y a pas de message d'erreur), mais quand je
l'affecte à une cellule, celle ci n'affiche que la première valeur (ici
BC01), et je n'arrive à rien en sélectionnant une place ou avec CTRL + MAJUS
+ ENTREE.

Est-ce possible à faire, et comment si c'est le cas.

Merci

10 réponses

1 2
Avatar
Jo-Soupin
bonjour,

une erreur dans la fin de ta fonction, elle doit se terminer par
Liste01=res.
Si tu veux les résultats exprimés sur une même colonne,
Liste01 = Application.Transpose(Res)



Bonjour,

Je désire ecrire une fonction qui renvoie la liste des valeurs différ entes
d'une plage de cellules. (fonction complémentaire à nb.diff)

Pour le contenu de la fonction, je n'ai pas trop de problème d'algo, ma is je
n'arrive pas à renvoyer une série de valeur, et que celle ci rempliss e les
cellules.
Exemple de fonction:


Public Function Liste01() As Variant()

Dim Res() As Variant

ReDim Res(1)
Res(0) = "BC01"
ReDim Preserve Res(2)
Res(1) = "BC32"
ListeDiff = Res

End Function

Donc ici, je voudrai qu'elle fonctionne de manière analogue à DROITER EG qui
affecte une matrice en sortie.
Cette fonction "marche" (il n'y a pas de message d'erreur), mais quand je
l'affecte à une cellule, celle ci n'affiche que la première valeur (i ci
BC01), et je n'arrive à rien en sélectionnant une place ou avec CTRL + MAJUS
+ ENTREE.

Est-ce possible à faire, et comment si c'est le cas.

Merci


Avatar
[___FreGoLi___]
C'est mois qui mal copié collé:

L'erreur est dans le copier coller que j'ai fais dans les news.
J'ai bien Liste01=Res en fin de fonction, mais cela n'affiche que la
première valeur dans la cellule ou je mets la formule.
Avatar
[___FreGoLi___]
Ok, merci, tout compris:

Il fallait que j'affecte EN LIGNE avec CTRL + MAJUS + ENTREE et non EN
COLONNE comme le benêt que je suis.

Merci de ton aide en tout cas.
Avatar
Jo-Soupin
FreGoli

Telle qu'elle est écrite, il te faut selectionner 2 cellules sur une
même rangée et valider par CTRL + MAJUS + ENTREE.
Si tu veux les résultats exprimés sur une même colonne, tu dois
terminer par
Liste01 = Application.Transpose(Res)

amicalement
Avatar
[___FreGoLi___]
Ok, j'ai tout compris,

dans le même ordre d'idée, peut-on savoir, dans la fonction appelée, si
'lutilisateur à sélectionné une ligne, ou une colonne, voire combien
d'éléments dans cette ligne / colonne, pour pouvoir affecter en sortie dans
le bon sens, et le bon nombre d'éléments ???
Avatar
Jo-Soupin
tout à fait, comme ceci :

If Selection.Rows.Count > 1 Then
Liste01 = Application.Transpose(Res)
Else
Liste01 = Res
End If
Avatar
[___FreGoLi___]
Encore merci pour ton aide.
Et pourque cela profite à tout le monde: ma fonction terminée :


Public Function ListeDiff(Cells As Range, _
Optional Compte As Boolean = False) As Variant()

Dim Res() As Variant
Dim I As Integer
Dim J As Integer
Dim Trouve As Boolean
Dim SelectionSize As Integer

'
' Compte et renvoie la liste de valeurs différentes d'une plage de
cellule
'
' Cells est la liste de cellules sur laquelle portera la fonction
' Compte est le booléen indiquant si on désire avoir le nombre de
' valeurs différentes comme première valeur de retour (defaut FAUX)
'
' NB: comme Cells est un Range, la plage de cellule doit être contigüe
'

ReDim Res(0)
Res(0) = 0
For I = 1 To Cells.Count
If Cells(I).Value <> "" Then
Trouve = False
For J = 1 To UBound(Res)
If Res(J) = Cells(I).Value Then
Trouve = True
Exit For
End If
Next J
If Not Trouve Then
ReDim Preserve Res(UBound(Res) + 1)
Res(UBound(Res)) = Cells(I).Value
Res(0) = Res(0) + 1
End If
End If
Next I
If Selection.Rows.Count > Selection.Columns.Count Then
SelectionSize = Selection.Rows.Count
Else
SelectionSize = Selection.Columns.Count
End If
If Not Compte Then
For I = 1 To UBound(Res)
Res(I - 1) = Res(I)
Next I
ReDim Preserve Res(UBound(Res) - 1)
End If
J = UBound(Res)
ReDim Preserve Res(SelectionSize)
For I = J + 1 To UBound(Res)
Res(I) = ""
Next I
If Selection.Rows.Count > 1 Then
ListeDiff = Application.Transpose(Res)
Else
ListeDiff = Res
End If

End Function
Avatar
AV
Et pourque cela profite à tout le monde: ma fonction terminée :


La plage à examiner est A2:A10
Liste des valeurs uniques :
Sélection B2:B10 -->
=SI(ESTNUM(PETITE.VALEUR(SI(EQUIV(A2:A10;A2:A10;0)=LIGNE(INDIRECT("1:"&LIGNES(A2
:A10)));EQUIV(A2:A10;A2:A10;0);"");LIGNE(INDIRECT("1:"&LIGNES(A2:A10)))));INDEX(
A2:A10;PETITE.VALEUR(SI(EQUIV(A2:A10;A2:A10;0)=LIGNE(INDIRECT("1:"&LIGNES(A2:A10
)));EQUIV(A2:A10;A2:A10;0);"");LIGNE(INDIRECT("1:"&LIGNES(A2:A10)))));"")
--> validation par ctrl+maj+entrée

AV

Avatar
[___FreGoLi___]
??? ça pas l'air de faire grand chose ???



Et pourque cela profite à tout le monde: ma fonction terminée :


La plage à examiner est A2:A10
Liste des valeurs uniques :
Sélection B2:B10 -->
=SI(ESTNUM(PETITE.VALEUR(SI(EQUIV(A2:A10;A2:A10;0)=LIGNE(INDIRECT("1:"&LIGNES(A2
:A10)));EQUIV(A2:A10;A2:A10;0);"");LIGNE(INDIRECT("1:"&LIGNES(A2:A10)))));INDEX(
A2:A10;PETITE.VALEUR(SI(EQUIV(A2:A10;A2:A10;0)=LIGNE(INDIRECT("1:"&LIGNES(A2:A10
)));EQUIV(A2:A10;A2:A10;0);"");LIGNE(INDIRECT("1:"&LIGNES(A2:A10)))));"")
--> validation par ctrl+maj+entrée

AV







Avatar
AV
??? ça pas l'air de faire grand chose ???


Hum..hum..
T'es sur d'avoir suivi pas à pas les "instructions" ?

AV

1 2