Transformer procédure en Fonction

Version imprimable

Bonjour le Forum,

Je me retrouve à nouveau confronté à un petit souci, je vous explique:

j'ai 3 sub:
- Sub1
- Sub2
- Sub3

et la 4ème à faire évoluer (Sub4)

voici mon code de la Sub4:

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
Sub Recherche()
 
Dim c As Range, Plage As Range
Dim Mot As String, cmpt As Byte
Dim MotsRecherches As Variant
Dim I As Integer
Dim ShCible As Worksheet
Dim LigneFeuilleCible As Long
 
        ' Feuille cible
        Set ShCible = Sheets("Feuille1")
 
        LigneFeuilleCible = ShCible.Cells(ShCible.Rows.Count, 2).End(xlUp).Row + 1
        MotsRecherches = Array("Mot1", "Mot2", "Mot3", "Mot4", "Mot5", "Mot6")
 
        'Feuille cible
        Set Plage = Sheets("Feuille5").UsedRange
 
        With ShCible
             For I = LBound(MotsRecherches, 1) To UBound(MotsRecherches, 1)
                 Set c = Plage.Find(What:=MotsRecherches(I), LookAt:=xlPart)  
                 If Not c Is Nothing Then
 
                    .Cells(LigneFeuilleCible, 2) = MotsRecherches(I)
 
                    Exit For
                 End If
                 Set c = Nothing
             Next I
         End With
 
     Set Plage = Nothing
     Set ShCible = Nothing
 
End Sub

Ce que je souhaite faire est de faire évoluer ceci en Feuille2 ou Feuille3:

Code:

1
2
 ' Feuille cible
        Set ShCible = Sheets("Feuille1")

En gros si Sub1 actif alors Feuille1
si Sub2 actif alors Feuille2

Code:

1
2
 ' Feuille cible
        Set ShCible = Sheets("Feuille2")

si Sub3 actif alors Feuille3

Code:

1
2
 ' Feuille cible
        Set ShCible = Sheets("Feuille3")

Pour info, j'active les Sub1,2 et 3 dans un userform grâce à 3 optionbutton, mais le Sub4 se trouve dans un module à part de celui de Usf

Merci d'avance

Seb

27/04/2015, 16h56
vinc_bilb

Bonjour,

Si j'ai bien compris votre demande, il faut exécuter une routine en fonction de celle qui l'appelle
Donc, vous pouvez juste passer votre 'Sub4' en fonction et passer la feuille en paramètre ....

Code:

Set ShCible = Sheets(SheetName)

et bien sur, vous le spécifier dans la routine appelante du style
Call Function_ExSub4("Feuille1")

Bonne continuation

Transformer Sub en Fonction

Re et bonjour Vinc_Bilb,

Merci pour ton intéressement,

Je m'en doutais qu'il fallait passer mon Sub4 en fonction :?

Hors, je n'ai jamais fait cela sauf pour de simple fonction

Je ne vois pas par quoi commencer, voici un essai:

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
Private Function Recherche()
 
Dim c As Range, Plage As Range
Dim Mot As String, cmpt As Byte
Dim MotsRecherches As Variant
Dim I As Integer
Dim ShCible As Worksheet
Dim LigneFeuilleCible As Long
 
        ' Feuille cible
        Set ShCible = Sheets(sheetName)
 
        LigneFeuilleCible = ShCible.Cells(ShCible.Rows.Count, 2).End(xlUp).Row + 1
        MotsRecherches = Array("Mot1", "Mot2", "Mot3", "Mot4", "Mot5", "Mot6")
 
        'Feuille cible
        Set Plage = Sheets("Feuille5").UsedRange
 
        With ShCible
             For I = LBound(MotsRecherches, 1) To UBound(MotsRecherches, 1)
                 Set c = Plage.Find(What:=MotsRecherches(I), LookAt:=xlPart)  
                 If Not c Is Nothing Then
 
                    .Cells(LigneFeuilleCible, 2) = MotsRecherches(I)
 
                    Exit For
                 End If
                 Set c = Nothing
             Next I
         End With
 
     Set Plage = Nothing
     Set ShCible = Nothing
 
End Function

J'imagine que la dedans, il faut que je déclare les feuilles entre parenthèse

Code:

Function Recherche()

Merci encore

Seb

28/04/2015, 05h15
Sebphyto

Bonjour le forum, et bonjour Vinc,

On dit que la nuit porte conseil.....

Pourrais-tu me dire à quoi correspond ceci?

Code:

Sheets(sheetName)

Le "sheetname", cela veut dire "nom de feuille", mais pas quoi je remplace cela?

dans ceci:

Code:

Private Function Recherche()

Entre-parenthèse, il faut que je déclare les feuilles j'imagine:

Code:

(Feuille1 as worksheet, Feuille2 as worksheet, etc...)

Enfin comme tu peux le voir, je patauge.....

Merci de pour tes futurs conseils

Seb
28/04/2015, 23h07
Invité

Bonsoir,
Une fonction ça retourne quelque chose!
Alors que la tu ne retourne rien!
Sub Recherche(feuille as string).
Et tu l'appel Recherche "feuill1"
28/04/2015, 23h24
kiki29

Salut, est-ce que cela éclaircira la situation, à lire et assimiler : Les fonctions personnelles dans Excel

Bonjour,

Pour compléter les différentes interventions et retour, à propos des différentes possibilités:

- Sub: peut prendre en compte des paramètres d'entrée (optionnels ou non, prédéfinis ou non, ....) et ne retourne rien

Exemple

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
Sub RefCheckScript()
    Call ReferencesCheck(RefName:="scripting", DisplLogMsg:=False)
End Sub
'---------------------------------------------------------------------------------------------------------------
Sub ReferencesCheck(Optional RefName As String, Optional DisplLogMsg As Boolean = False)
' Liste les references VBA attachees au classeur
 
    Dim RefInd As Integer,  FoundRef As Boolean
    Dim MsgHead As String, MsgPrompt As String, Msgtype As Variant
 
    With ThisWorkbook.VBProject.References
 
        FoundRef = False
 
        For RefInd = 1 To .Count
 
            If RefName <> "" Then
 
                If InStr(1, RefName, .Item(RefInd).Name, vbTextCompare) > 0 Then
                    FoundRef = True
                    MsgPrompt = " Reference " & RefName & " found in: " & .Item(RefInd).Name & "-" & .Item(RefInd).Description & vbCrLf
                    Exit For
                End If
 
            Else:   ' No reference name to check
                MsgPrompt = MsgPrompt & .Item(RefInd).Name & vbTab & .Item(RefInd).Description & vbCrLf  '& vbTab & .Item(RefInd).FullPath & vbCrLf
 
            End If
 
        Next
 
    End With
    (...)
 
    If DisplLogMsg = True Or Msgtype = vbExclamation Then MsgBox MsgPrompt, Msgtype, MsgHead
 
End Sub

- Func: peut prendre en compte des paramètres d'entrée (optionnels ou non, prédéfinis ou non, ....) et retourne quelquechose ....

Exemple:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Function GetDimArray(ArInput As Variant) As Integer
' Retourne les dimensions d'un array
 
On Error GoTo Err_GetDimArray:
 
Dim i As Integer
Dim ChckDim As Integer
 
        ' Augmente les dimensions de l'array jusqu'à ce que l'on déclenche un erreur
    i = 0
    Do While True:
        i = i + 1
        ChckDim = UBound(ArInput, i)
    Loop
 
Err_GetDimArray:
    GetDimArray = i - 1
    err.Clear
End Function

Si ça peut aider ....

Bonjour à tous les participants de mon post,

De mon côté ce n'est franchement pas un grand succès....Je patauge, et encore si je pouvais avancer en pataugeant çà serai bien mais c'est limite sable mouvant :roll:

@rudurupt:

Ravi de te revoir sur un de mes post,
ce que tu veux dire c'est :

Code:

Private Function Recherche(Feuille1 as string, Feuille2 as string, Feuille3 as string)

Et je l'appelle comme cela dans ma sub:

Code:

Recherche "feuill1"

@Kiki29:
Merci pour ton intervention, J'ai déjà lu le tuto de Silkyroad à ce sujet et bien d'autre d'ailleurs, qui soit dit en passant, est un très bon rédacteur. Mais pour les functions de multiplication, division etc...je vois très bien comment on fait...mais pour mon cas je n'arrive pas à voir les concordances entre celle-ci...

@Vinc:

Désolé mais cela ne m'aide pas, j'ai du mal à comprendre le rapport avec mon code...de même quel est le rapport entre les deux codes que tu m'as soumis?

Pour mon code, j'aime faire les choses seules (Autodidacte) sans que l'on me ponde un code tout fait, mais là franchement, il y a un truc que je n'ai pas 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 Private Function Recherche(Feuille1 as string, Feuille2 as string, Feuille3 as string) Dim c As Range, Plage As Range Dim Mot As String, cmpt As Byte Dim MotsRecherches As Variant Dim I As Integer Dim ShCible As Worksheet Dim LigneFeuilleCible As Long ' Feuille cible Set ShCible = Sheets(sheetName) LigneFeuilleCible = ShCible.Cells(ShCible.Rows.Count, 2).End(xlUp).Row + 1 MotsRecherches = Array("Mot1", "Mot2", "Mot3", "Mot4", "Mot5", "Mot6") 'Feuille cible Set Plage = Sheets("Feuille5").UsedRange With ShCible For I = LBound(MotsRecherches, 1) To UBound(MotsRecherches, 1) Set c = Plage.Find(What:=MotsRecherches(I), LookAt:=xlPart) If Not c Is Nothing Then .Cells(LigneFeuilleCible, 2) = MotsRecherches(I) Exit For End If Set c = Nothing Next I End With Set Plage = Nothing Set ShCible = Nothing End Function
Delà l'appel de celle-ci:

Code:

Recherche "Feuille1" ou "Feuille2" ou "Feuille3"

Par contre je mets quoi la dedans à la place de (SheetName) car dans la function il ne connaît pas "SheetName":

Code:

Set ShCible = Sheets(SheetName)

Seb

29/04/2015, 23h35
patricktoulon

heu
bonjour
sheeetname est une variable si elle n'apas été instruite c'est normal
il y a plusieurs façon de ce servir d'une fonction avec argument injecté

lafonction peut retourner une variable(string,variant,numerique,et meme object
exemple
Code:

1 2 3 sub testfunction() msgbox recherche "feuil1","a1" end sub
maintenant la fonction
Code:

1 2 3 function recherche(feuille as worksheet,celadress as string)as string recherche=sheets(feuille).range(celadress).value end function
il n'est pas obligé que qu'une fonction retourne quoi que que se soit elle peut tout bonnement exécuter une action

exemple
Code:

1 2 3 sub test2function( ecrit "feuil1",[a1],"toto" end sub
maintenant la fonction
Code:

1 2 3 4 function ecrit(feuille,cel as object,texte as string) sheets(feuille).cel.value=texte end function
voila est ce plus clair pour toi ?

Bonjour Patrick,

Merci de t'intéresser à cette discussion,

Je viens d'essayer tes codes, et malheureusement pas un seul fonctionne

Code:

1
2
3
sub testfunction()
msgbox recherche "feuil1","a1"
end sub

Erreur de syntaxe

Code:

1
2
3
4
function ecrit(feuille,cel as object,texte as string)
 
sheets(feuille).cel.value=texte
end function

Méthode non gérer

Bref cela n'est pas important en soi.

J'arrive à faire fonctionner des fonctions simples, mais je n'arrive pas à l'adapter pour moi

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
Private Function Recherche(Feuille1 as string, Feuille2 as string, Feuille3 as string)
 
Dim c As Range, Plage As Range
Dim Mot As String, cmpt As Byte
Dim MotsRecherches As Variant
Dim I As Integer
Dim ShCible As Worksheet
Dim LigneFeuilleCible As Long
 
        ' Feuille cible
        Set ShCible = Sheets(sheetName)
 
        LigneFeuilleCible = ShCible.Cells(ShCible.Rows.Count, 2).End(xlUp).Row + 1
        MotsRecherches = Array("Mot1", "Mot2", "Mot3", "Mot4", "Mot5", "Mot6")
 
        'Feuille cible
        Set Plage = Sheets("Feuille5").UsedRange
 
        With ShCible
             For I = LBound(MotsRecherches, 1) To UBound(MotsRecherches, 1)
                 Set c = Plage.Find(What:=MotsRecherches(I), LookAt:=xlPart)  
                 If Not c Is Nothing Then
 
                    .Cells(LigneFeuilleCible, 2) = MotsRecherches(I)
 
                    Exit For
                 End If
                 Set c = Nothing
             Next I
         End With
 
     Set Plage = Nothing
     Set ShCible = Nothing

je ne vois pas pour "SheetName"....

Je ne sais pas entre

Code:

Worksheet ou string

Enfin il y a quelque chose que je n'ai certainement pas compris

Oulala, je suis dans le flou :aie:

Autodidacte c bien , mais on n'a toujours besoin de quelqu'un
Seb

bonjour,

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
Sub test()
MsgBox Recherche(Sheets("feuil1"), Sheets("Feuille5").UsedRange)
End Sub
 
Private Function Recherche(ShCible As Worksheet, Plage As Range) As Boolean
Dim c As Range
Dim Mot As String, cmpt As Byte
Dim MotsRecherches As Variant
Dim I As Integer
Dim LigneFeuilleCible As Long
        LigneFeuilleCible = ShCible.Cells(ShCible.Rows.Count, 2).End(xlUp).Row + 1
        MotsRecherches = Array("Mot1", "Mot2", "Mot3", "Mot4", "Mot5", "Mot6")
        'Feuille cible
        With ShCible
             For I = LBound(MotsRecherches, 1) To UBound(MotsRecherches, 1)
                 Set c = Plage.Find(What:=MotsRecherches(I), LookAt:=xlPart)
                 If Not c Is Nothing Then
                    .Cells(LigneFeuilleCible, 2) = MotsRecherches(I)
                    Recherche = True
                    Exit For
                 End If
                 Set c = Nothing
             Next I
         End With
End Function

01/05/2015, 22h26
Sebphyto

Bonjour à tous,

@Rdurupt

Bon bah, un code tout pondu, qui fonctionne parfaitement, je te remercie....encore et encore une fois.

Merci également à toutes les personnes ayant participé à ce fil de discussion fort porteur pour moi car à chaque fois que je viens ici, je ne repars jamais sans connaissance.

Merci pour vos lumières et au plaisir

Namasté

Séb