fonction en VBA, avec resultat sur plusieurs cellules

Bonjour,

A ma connaissance, je ne crois pas qu'il soit possible de faire une seule
fonction
renvoyant plusieurs résultats (mais quelq'un de plus féru apportera
peut-être la réponse).
Cependant, voici une solution qui, si elle plutôt compliquée, à l'air de
fonctionner.

ATTENTION aux éventuelles interférences au niveau des évènements
PAR PRUDENCE FAITES L ESSAI SUR UNE COPIE DE VOTRE CLASSEUR

COMPORTE:
3 procédures. Les 2 procédures fonction (PMO1 PMO2) à copier dans un module
standard. La procédure Workbook_SheetChange à copier dans le module
ThisWorkBook.
Vous noterez que la fonction PMO2 est déclarée Private pour éviter qu'elle
soit visible
dans le menu Insertion/Fonction puisque son existence dépend de l'existence
de la
fonction PMO1.

CELA FAIT:
Supposons la plage A1:C3 renseignée avec des données. Si en E5 (par exemple)
vous
tapez =PMO1(A1:C3) vous obtiendrez en E5 la somme de toutes les valeurs
numériques
contenues dans cette plage puis la multiplication des mêmes éléments en F5
(ceci sous
forme de formules. Ainsi si vous changez la valeur de A1 le recalcul se fera
automatiquement)

COMMENT CELA MARCHE:
Pour la fonction PMO1 aucun souci c'est le processus normal.
La fonction PMO2 est activée par l'évènement Change de ThisWorkBook qui
identifie
s'il s'agit d'une fonction PMO1 par la ligne de code
If Left(A$, 5) = "=PMO1" Then
Si vous voulez adapter le nom des fonctions à votre convenance pensez à
modifier en
conséquence la ligne ci-dessus ainsi que la ligne
R.Formula = "=PMO2" & Mid(A$, 6)

*********************** Dans ThisWorkbook
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim R As Range
Dim A$
On Error GoTo Erreur
A$ = Target.Formula
If A$ = "" Then Exit Sub
If Left(A$, 5) = "=PMO1" Then
Application.EnableEvents = False
Set R = ThisWorkbook.Sheets(Sh.Name).Range(Target.Address).Offset(0, 1)
R.Formula = "=PMO2" & Mid(A$, 6)
Application.EnableEvents = True
End If
Erreur:
End Sub
*********************** Dans un module Standard
'________________________________
Function PMO1(Plage As Range) As Double
Dim var
Dim i&
Dim j&
Dim x#
On Error GoTo Erreur
var = Plage
For i& = 1 To UBound(var, 1)
For j& = 1 To UBound(var, 2)
If IsNumeric(var(i&, j&)) Then
x# = x# + var(i&, j&)
End If
Next j&
Next i&
PMO1 = x#
Exit Function
Erreur:
PMO1 = Plage
End Function
'________________________________
Private Function PMO2(Plage As Range) As Double
Dim var
Dim i&
Dim j&
Dim x#
On Error GoTo Erreur
x# = 1
var = Plage
For i& = 1 To UBound(var, 1)
For j& = 1 To UBound(var, 2)
If IsNumeric(var(i&, j&)) And _
Not IsEmpty(var(i&, j&)) Then
x# = x# * var(i&, j&)
End If
Next j&
Next i&
PMO2 = x#
Exit Function
Erreur:
PMO2 = Plage
End Function

Cordialement.
--
PMO
Patrick Morange

Bonjour, je veux ecrire une fonction personalisee en VBa sous Excel, et qui
renverrai plusieurs resultats, chacun dans une cellule distincte.

Par exemple (avec code incorrect) de ce que je voudrais:

Function test(a, b) As Variant

test(1, 1) = a + b
test(1, 2) = a * b

End Function

Pouvez vous m'aider a corriger le texte ? Merci

Bonjour.

Function Test(a, b) As Variant()
Dim Tblo(1)
Tblo(0) = a + b
Tblo(1) = a * b
Test = Tblo
End Function

Pour tester :
A1=4
B1=6
Selectioner C5:D5
=Test(A1;B1) en matricielle

Alain CROS

"Mimi" <Mimi@discussions.microsoft.com> a écrit dans le message de news: 40044744-E817-4198-ADEF-12571453B293@microsoft.com...
| Bonjour, je veux ecrire une fonction personalisee en VBa sous Excel, et qui
| renverrai plusieurs resultats, chacun dans une cellule distincte.
|
| Par exemple (avec code incorrect) de ce que je voudrais:
|
| Function test(a, b) As Variant
|
| test(1, 1) = a + b
| test(1, 2) = a * b
|
| End Function
|
| Pouvez vous m'aider a corriger le texte ? Merci

Une fonction perso peut renvoyer un tableau de valeurs, lesquelles peuvent être
renvoyées chacune dans une cellule différente en utilisant une validation
matricielle (Ctrl+MAj+Entrée).
Exemple simple, qui permet de renvoyer le résultat aussi bien en ligne qu'en
colonne :

Function MatricielleVBA(cell1, cell2)
Dim Arr As Variant
Arr = Array(cell1 + cell2, cell1 * cell2)
If Application.Caller.Rows.Count = 1 Then
MatricielleVBA = Arr
Else
MatricielleVBA = Application.Transpose(Arr)
End If
End Function

Pour l'utiliser :
en A1 -> 10
en A2 -> 15

Sélectionner B1:C1 ou B1:B2 et saisir
=MatricielleVBA(A1;A2)
et valider avec Ctrl+Maj+Entrée

--
Gaenonius

Bonjour, je veux ecrire une fonction personalisee en VBa sous Excel, et qui
renverrai plusieurs resultats, chacun dans une cellule distincte.

Par exemple (avec code incorrect) de ce que je voudrais:

Function test(a, b) As Variant

test(1, 1) = a + b
test(1, 2) = a * b

End Function

Pouvez vous m'aider a corriger le texte ? Merci