VBA EXCEL valeur cellule d'un tableau

Bonjour à tous,
et merci d'avance à celui qui prendra le temps de me répondre. Je suis débutant en VBA, mais j'en ai besoin pour finir de faire un grille sur excel.
J'ai besoin d'une fonction, que j'entre dans une cellule d'une feuille, et qui en entré possède 3 arguments. Cette fonction va chercher dans une autre feuille de mon classeur (Durée_vie_lampes) la valeur d'une cellule d'un tableau dont le tite de la colonne est lampe et le titre de la ligne est ballastCycle. Elle doit me sortir une chaine de caractere. Et la ba rien...
Voici mon code... si quelqu'un identifie les problèmes... je deviens fou la...

"Function RechercheDureeVie(lampe As String, ballast As String, cycle As String) As String
Dim numColonne As Integer
Dim numLigne As Integer
Dim ballastCycle As String
'concatener ballast et cycle

ballastCycle = ballast & "_" & cycle

Worksheets("Durée_vie_lampes.xls").UsedRange.Select
numColonne = Selection.Find(lampe, ActiveCell, xlValues, xlPart, xlByRows, xlNext, False).Column
numLigne = Selection.Find(ballastCycle, ActiveCell, xlValues, xlPart, xlByRows, xlNext, False).Row

RechercheDureeVie = ActiveSheet.Range(numLigne, numColonne).Value

End Function"
Merci d'avance
titi
Configuration: Windows XP
Firefox 2.0.0.4

18 réponses

  1. Bonjour,

    N'ayant pas les données, je ne puis tout tester !!!

    Mais voici quelques idées !

    Function RechercheDureeVie(lampe As String, ballast As String, cycle As String) As String
    
        Dim numColonne As Integer
        Dim numLigne As Integer
        Dim ballastCycle As String
        
        Application.Volatile           ' Permet l'exécution à chaque intervention sur la feuille
        
        'concatener ballast et cycle
        ballastCycle = ballast & "_" & cycle
        
        'Worksheets("Durée_vie_lampes.xls").UsedRange.Select
        Workbooks("Durée_vie_lampes.xls").Activate
        Sheets("Feuil1").Select
        
        numColonne = Selection.Find(lampe, ActiveCell, xlValues, xlPart, xlByRows, xlNext, False).Column
        numLigne = Selection.Find(ballastCycle, ActiveCell, xlValues, xlPart, xlByRows, xlNext, False).Row
        
        If (ActiveSheet.Range(numLigne, numColonne).Value <> "") Then
            RechercheDureeVie = ActiveSheet.Range(numLigne, numColonne).Value
        Else
            RechercheDureeVie = "Nil"
        End If
    
    End Function
    '
    


    Lupin
    3
    1. Salut à tous,

      J'ai élaboré un tableau sous excel de 136 L x46 C. Chaque cellule de ce tableau dout contenir une fonction dont j'ai déja la formule.
      Le fait de saisir manuellement la fonction dans chaque cellule est fastidieux.

      Mon problème est de trouver une fonction qui me permettra de renseigner chaque cellule du tableau selectionné de façon automatique.

      Merci de m'aider.
      0
      1. Bonjour,

        Exemple type :

        Sub TranscritFormule()
        
            Dim Plage As Range, Cible As Range
            Dim Formule As String
            
            ' Spécifié ici la plage à couvrir
            Set Plage = Range("A1:AT146")
            
            ' Renseigner ici la variable par la formule
            Formule = "=SUM(A1:A2)"
            
            For Each Cible In Plage
                Cible.FormulaR1C1 = Formule
            Next Cible
            
        End Sub
        


        Lupin
        1
        1. Merce Lupin de me repondre.

          Je signale que la fonction renseigne les cellules comme je l'avais signifié sauf que la même formule est répétée dans chaque cellule. Mais je me rend compte que je n'avais pas été très précis hier.

          Ma formule qui est la suivante =NB.SI(R11:R45475;CONCATENER(AB11;W13))
          doit incrémenter l'indice de la colonne sur une ligne et incrémenter l'indice de la ligne sur la colonne seulement pour la partie concatener.

          * R11:R45475 cette partie de la formule est figée car la recherche se fait sur la même plage.
          * CONCATENER(AB11;W13) pour cette partie, l'indice de la colonne incrémente sur une ligne et l'indice de la ligne incrémente sur la colonne.

          Merce d'avance
          0
          1. re:

            Je me disais aussi qu'il devait y avoir quelque chose qui manque :

            Pour te fournir une soluce adéquate, j'ai besoin de quelques infos !

            Première adresse de la formule : [ A1 ]
            Dernière adresse de la formule : [ AX ] -> ou x serait la dernière ligne de data

            Répétition de la formule :
            =NB.SI(R11:R45475;CONCATENER(AB11;W13))
            =NB.SI(R11:R45475;CONCATENER(AC11;X13))
            ...
            ou
            =NB.SI(R11:R45475;CONCATENER(AB11;W13))
            =NB.SI(R11:R45475;CONCATENER(AB12;W14))
            ...

            Je ne suis pas sur de bien comprendre le texte :
            " ... l'indice de la colonne incrémente sur une ligne et l'indice de la ligne incrémente sur la colonne. "

            Lupin
            0
            1. Bonjour,

              tu ne connais pas l'utilisation de "$" dans les coordonnées de cellules ?
              =NB.SI($R$11:$R$45475;CONCATENER(AB11;W13))

              et tu recopies ta formule partout
              0
              1. Lupin,

                En reponse à ta question;

                Première adresse de la formule : [ AC11 ]
                Dernière adresse de la formule : [ BV146 ]

                Répétition de la formule :
                =NB.SI(R11:R45475;CONCATENER(AB11;W13))
                =NB.SI(R11:R45475;CONCATENER(AB11;W13))
                =NB.SI(R11:R45475;CONCATENER(AB11;W13))
                =NB.SI(R11:R45475;CONCATENER(AB11;W13))

                C'est la valeur que contient toutes les cellules après l'exécution du prog.

                Pourtant je veux avoir:

                sur la même LIGNE :

                Ligne=17
                =NB.SI(R11:R45475;CONCATENER(AB17;W13))
                =NB.SI(R11:R45475;CONCATENER(AB17;W14))
                =NB.SI(R11:R45475;CONCATENER(AB17;W15))
                =NB.SI(R11:R45475;CONCATENER(AB17;W16))

                sur la même COLONNE:
                colonne=20
                =NB.SI(R11:R45475;CONCATENER(AB17;W20))
                =NB.SI(R11:R45475;CONCATENER(AB18;W20))
                =NB.SI(R11:R45475;CONCATENER(AB19;W20))
                =NB.SI(R11:R45475;CONCATENER(AB20;W20))

                Merci Lupin.

                ################################################################

                Merci le Père,

                Ta formule marche super bien sauf que je suis obligé de mettre à jour manuellement la première ligne avant de faire une recopie pour chaque colonne ( haut vers le bas). Car en faisant une copie sur la ligne (gauche vers la droite), je n'ai plus mon (AB;W) mais des AB > AC > AD > .... et le W en X > Y > Z ...
                Je ne dois pas figer AB ni W puisqu'il doit évoluer.

                Merci le Père
                0
                1. re:

                  Voilà, je veux être sur de bien comprendre.

                  ' Formule

                  ' [AC11] = "=NB.SI(R11:R45475;CONCATENER(AB11;W29))"
                  ' [AC12] = "=NB.SI(R11:R45475;CONCATENER(AB12;W29))"
                  ' ...

                  ' [AD11] = "=NB.SI(R11:R45475;CONCATENER(AB11;W30))"
                  ' [AD12] = "=NB.SI(R11:R45475;CONCATENER(AB12;W30))"
                  ' ...

                  ' ...
                  ' [BV145] = "=NB.SI(R11:R45475;CONCATENER(AB145;W74))"
                  ' [BV146] = "=NB.SI(R11:R45475;CONCATENER(AB146;W74))"

                  Code en cours et non complèté !

                  Sub TranscritFormule()
                  
                      Dim Plage As Range, Cible As Range
                      Dim Formule As String
                      Dim Col1 As String, Col2 As String
                      Dim Lig1 As Long, Lig2 As Long
                      
                      Set Plage = Range("AC11:BV146")
                    
                      For Each Cible In Plage
                          Col1 = 1
                          Col2 = 2
                          Lig1 = Cible.Row
                          Lig2 = 1
                          
                          Formule = "=NB.SI(R11:R45475;CONCATENER(" & Col1 & Lig1 & ";" & Col2 & Lig2 & "))"
                          Cible.FormulaR1C1 = Formule
                      Next Cible
                      
                  End Sub
                  '
                  


                  Lupin
                  0
                  1. je n'ai plus mon (AB;W) mais des AB > AC > AD > .... et le W en X > Y > Z ...
                    c'est ce que je croyais que tu voulais, tu avais dit "l'indice de colonne s'incrémente sur une ligne"

                    si ta 1ère formule est en AC11, ça doit donner :

                    =NB.SI($R$11:$R$45475;CONCATENER("AB" & (LIGNE()); "W" & CELLULE("col";AC11)-16))
                    0
                    1. Merci le Père,

                      Ta formule marche super bien sauf que je suis obligé de mettre à jour
                      manuellement la première ligne avant de faire une recopie pour chaque
                      colonne ( haut vers le bas). Car en faisant une copie sur la ligne
                      (gauche vers la droite), je n'ai plus mon (AB;W) mais des AB > AC > AD > ....
                      et le W en X > Y > Z ...
                      Je ne dois pas figer AB ni W puisqu'il doit évoluer.

                      Merci le Père
                      0
                      1. Salut,

                        L'évolution est parfaite Lupin.
                        C'est comme je le veux

                        Merci d'avance.
                        0
                        1. Rebonjour khubyk,

                          voici donc le résultat final, enfin je crois !

                          Option Explicit
                          
                          Sub TranscritFormule()
                          
                              Dim Plage As Range, Cible As Range
                              Dim Formule As String
                              Dim Col1 As String, Col2 As String
                              Dim Lig1 As Long, Lig2 As Long
                              Dim Compteur As Double
                              
                              Compteur = 0
                              Application.ScreenUpdating = False
                              Set Plage = Range("AC11:BV146")
                              For Each Cible In Plage
                                  Col1 = ChercheColonne(Cible):   Lig1 = Cible.Row
                                  Col2 = "W":     Lig2 = Cible.Column
                                  Formule = "=COUNTIF(R11:R45475;CONCATENER(" & Col1 & Lig1 & ";" & Col2 & Lig2 & "))"
                                  Cible.Clear
                                  Cible.FormulaR1C1Local = Formule
                                  Compteur = (Compteur + 1)
                              Next Cible
                              Application.ScreenUpdating = False
                              
                              MsgBox "Fin" & vbLf & Compteur
                              
                          End Sub
                          '
                          
                          Private Function ChercheColonne(ByVal Cellule As Range) As String
                          
                              Dim strAdresse As String, Colonne As String
                              Dim Position As Long, ascCode As Integer
                              
                              ChercheColonne = ""
                              strAdresse = Cellule.Address
                              Position = InStr(1, strAdresse, "$", vbTextCompare)
                              strAdresse = Mid(strAdresse, (Position + 1))
                              Position = InStr(1, strAdresse, "$", vbTextCompare)
                              strAdresse = Mid(strAdresse, 1, (Position - 1))
                              If (Len(strAdresse) > 1) Then
                                  ascCode = (Asc(Mid(strAdresse, 2, 1)) - 1)
                                  If (Mid(LCase(strAdresse), 2, 1) = "a") Then
                                      ascCode = (ascCode + 1)
                                  End If
                                  strAdresse = Mid(strAdresse, 1, 1) & Chr(ascCode)
                              Else
                                  ascCode = (Asc(strAdresse) - 1)
                                  If (LCase(strAdresse) = "a") Then
                                      ascCode = (ascCode + 1)
                                  End If
                                  strAdresse = Chr(ascCode)
                              End If
                              ChercheColonne = strAdresse
                          
                          End Function
                          '
                          

                          Lupin
                          0
                          1. un petit dernier pour la route et je m'en vais :

                            =NB.SI($R$11:$R$45475;CONCATENER($AB11;INDIRECT("W" & CELLULE("col";AC11)-16)))
                            0
                            1. suite :

                              j'ai trouvé une erreur dans la sous-fonction, je n'ai pas traité la colonne précédente à [AA].

                              la je vais souper, mais je vais refaire le code.

                              @+
                              Lupin
                              0
                              1. Contributeur
                                Bonjour,

                                ou pour simplifier il est possible d'utilser les références L1C1 :
                                Destination.FormulaR1C1 = "=RC[-1] & R[2]C[-6]"
                                J'ai mis juste la partie relative...
                                Eventuellement si l'offset colonne peut-être amené à changer le calculer une fois au début dans une variable

                                eric
                                0
                                1. Salut Lupin,

                                  Je viens te remercier infiniment pour ton dernier code . Il marche impec après une légère touche. Je n'y serai pas arrivé sans toi. Ci-dessou le code final:

                                  Option Explicit

                                  Sub TranscritFormule1()

                                  Dim Plage As Range, Cible As Range
                                  Dim Formule As String
                                  Dim Col1 As String, Col2 As String
                                  Dim Lig1 As Long, Lig2 As Long
                                  Dim Compteur As Double

                                  Compteur = 0
                                  Application.ScreenUpdating = False
                                  Set Plage = Range("AC11:BV146")
                                  For Each Cible In Plage
                                  Col1 = "AB": Lig1 = Cible.Row
                                  Col2 = "W": Lig2 = Cible.Column - 18
                                  Formule = "=NB.SI(R11:R45475;CONCATENER(" & Col1 & Lig1 & ";" & Col2 & Lig2 & "))"
                                  Cible.Clear
                                  Cible.FormulaR1C1Local = Formule
                                  Compteur = (Compteur + 1)
                                  Next Cible
                                  Application.ScreenUpdating = False

                                  MsgBox "Fin" & vbLf & Compteur

                                  End Sub
                                  '

                                  100000 fois merci

                                  khubyk
                                  1
                                  1. Bonsoir

                                    ta formule donne un W11 là où tu avais demandé un W13 le vendredi 7 à 18h00:26
                                    ma formule de 21h24 hier était donc correcte en mettant -18 au lieu de -16

                                    Na !
                                    0
                                    1. Salut khubyk,

                                      J'ai été absorbé par d'autres travaux. Je suis bien content que le tout
                                      soit à ton goût. C'est très probablement l'une de mes dernières interventions.

                                      Bonne continuité.
                                      Michel
                                      0