Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2010 Recherche inversé dans tableau

anna59

XLDnaute Nouveau
Bonjour,

J’ai récupéré ce fichier ou le code VBA permet de récupéré avec une fonction, selon le non dans le tableau, il récupère l’entête de la ligne et de la colonne.

Or, ce que j'ai besoin c'est : si la valeur correspond, je voudrais l'entête de colonne et le chiffre qui correspond au croisement des deux entêtes

Pourriez-vous m'aider ?
 

Pièces jointes

  • RDV.xlsm
    12.5 KB · Affichages: 30

soan

XLDnaute Barbatruc
Inactif
Bonjour anna,

bienvenue sur le site XLD !

j'ai pas eu besoin d'adapter ton code VBA pour la bonne raison que ton fichier Excel, bien qu'ayant l'extension .xlsm, ne contenait absolument aucun code VBA ! j'ai donc dû écrire entièrement tes 2 fonctions RDV() et NOUV() ; un grand merci pour m'avoir si bien mâché le travail !

* formule en H4 (déjà tirée vers le bas jusqu'en H7) : =RDV("C4:E7";G4)

* formule en H12 (déjà tirée vers le bas jusqu'en H15) : =NOUV("C12:E15";G12)



code VBA de Module1 :

VB:
Option Explicit

Function RDV(plg$, nom$) As String
  If nom = "" Then Exit Function
  Dim s0$, s1$, s2$, p As Byte, a%, b&
  Dim co1%, co2%, col%, lg1&, lg2&, lig&
  s0 = Range(plg).Address(0, 0)
  p = InStr(s0, ":"): If p = 0 Then Exit Function
  s1 = Left$(s0, p - 1): s2 = Right$(s0, Len(s0) - p)
  With Range(s1): co1 = .Column: lg1 = .Row: End With
  With Range(s2): co2 = .Column: lg2 = .Row: End With
  s2 = "": a = lg1 - 1: b = co1 - 1
  For col = co1 To co2
    For lig = lg1 To lg2
      s1 = Cells(lig, col)
      If s1 <> "" Then If s1 = nom Then _
        s2 = s2 & Cells(a, col) & " " & Cells(lig, b) & " / "
    Next lig
  Next col
  If s2 <> "" Then s2 = Left$(s2, Len(s2) - 3)
  RDV = s2
End Function

Function NOUV(plg$, jour$) As String
  If Not IsDate(jour) Then Exit Function
  Dim s0$, s1$, s2$, p As Byte, a%, b&
  Dim co1%, co2%, col%, lg1&, lg2&, lig&
  s0 = Range(plg).Address(0, 0)
  p = InStr(s0, ":"): If p = 0 Then Exit Function
  s1 = Left$(s0, p - 1): s2 = Right$(s0, Len(s0) - p)
  With Range(s1): co1 = .Column: lg1 = .Row: End With
  With Range(s2): co2 = .Column: lg2 = .Row: End With
  s2 = "": a = co1 - 1: b = lg1 - 1
  For lig = lg1 To lg2
    If Cells(lig, a) = CDate(jour) Then
      For col = co1 To co2
        s1 = Cells(lig, col)
        If s1 <> "" Then s2 = s2 & Cells(b, col) & " " & s1 & " / "
      Next col
    End If
  Next lig
  If s2 <> "" Then s2 = Left$(s2, Len(s2) - 3)
  NOUV = s2
End Function

ça va ? t'es pas trop déçue qu'j'ai indiqué ci-dessus quel est mon code VBA ? t'aurais p't'être préféré que j'te laisse un peu d'temps pour essayer d'le deviner ? j'dis ça car t'as l'air de bien aimer jouer aux devinettes ; la prochaine fois, tu donneras p't'être ton code VBA dans le style charade ou dans le style rébus ? (ça s'ra toujours mieux que dans le style encre sympathique)

trêve de plaisanteries, j'te remercie quand même pour avoir proposé ton exo Excel, qui était très intéressant à faire ; j'espère que c'que j'ai fait te conviendra.

si besoin, tu peux demander une adaptation.
à te lire pour avoir ton avis.

soan
 

Pièces jointes

  • RDV.xlsm
    18.4 KB · Affichages: 6
Dernière édition:

anna59

XLDnaute Nouveau
Bonjour soan,

oui, désolé voila le code, qu'en penses-tu ?
J'essaye ton code encore merci


Function RDV(tableau As Range, personne As Range)

col_entete = tableau.Columns(1).Column - 1
ligne_entete = tableau.Rows(1).Row - 1

RDV = " "


For Each cell In tableau
If cell.Value = personne.Value Then
'ajoute le creneau
creneau = Cells(ligne_entete, cell.Column).Value & " " & Cells(cell.Row, col_entete)

RDV = RDV & creneau & " / "

End If
Next cell
End Function

Function JTRAV(tableau As Range, nh As Range)

col_entete = tableau.Columns(1).Column - 1
ligne_entete = tableau.Rows(1).Row - 1
jour = ligne_entete.Value

JTRAV = " "


For Each cell In tableau
If cell.Value = jour.Value Then
'ajoute le creneau
creneau = Cells(ligne_entete, cell.Column).Value & " " & Cells(cell.Row, col_entete)

JTRAV = JTRAV & creneau & " / "

End If
Next cell
End Function
 

anna59

XLDnaute Nouveau
re Soan,
Super ton code fonctionne !!!

je viens tous juste de découvrir le VBA

c'est possible que si dans mon tableau il y a des changement entre deux, automatiquement, ça se recalcul ?
J'en demande trop peut-être ?

Autre chose pourrais-tu m'expliquer ton code ?
Merci...
 

soan

XLDnaute Barbatruc
Inactif
Bonsoir anna,

tu as écrit : « Super ton code fonctionne !!! »

merci pour ton retour !



tu as écrit : « c'est possible que si dans mon tableau il y a des changement entre deux, automatiquement, ça se recalcule ? »

oui, tout à fait ; je te laisse faire les tests avec la nouvelle version du fichier joint. pour le code VBA, tu pourras voir que j'ai juste ajouté en 1ère instruction des 2 fonctions : Application.Volatile



tu as écrit : « Autre chose pourrais-tu m'expliquer ton code ? »

oui, mais ça va être un peu long à faire ; alors ça ne sera pas pour tout de suite ; surtout que j'vais arrêter mon PC pour aller faire une longue pause-repas.

soan
 

Pièces jointes

  • RDV.xlsm
    18.3 KB · Affichages: 5

soan

XLDnaute Barbatruc
Inactif
Bonjour anna,

tout ce qui suit est pour les 2 fonctions RDV() et NOUV().

en faisant mon explication de code VBA, je m'suis rendu compte que j'avais inutilement compliqué quelque chose : s0 = Range(plg).Address(0, 0) est inutile ➯ j'ai tout simplement utilisé plg à la place de s0, puis j'ai supprimé la déclaration de la variable s0 devenue inutile ; le fichier joint contient ce nouveau code VBA de Module1 :​

VB:
Option Explicit

Function RDV(plg$, nom$) As String
  Application.Volatile
  If nom = "" Then Exit Function
  Dim s1$, s2$, p As Byte, a%, b&
  Dim co1%, co2%, col%, lg1&, lg2&, lig&
  p = InStr(plg, ":"): If p = 0 Then Exit Function
  s1 = Left$(plg, p - 1): s2 = Right$(plg, Len(plg) - p)
  With Range(s1): co1 = .Column: lg1 = .Row: End With
  With Range(s2): co2 = .Column: lg2 = .Row: End With
  s2 = "": a = lg1 - 1: b = co1 - 1
  For col = co1 To co2
    For lig = lg1 To lg2
      s1 = Cells(lig, col)
      If s1 <> "" Then If s1 = nom Then _
        s2 = s2 & Cells(a, col) & " " & Cells(lig, b) & " / "
    Next lig
  Next col
  If s2 <> "" Then s2 = Left$(s2, Len(s2) - 3)
  RDV = s2
End Function

Function NOUV(plg$, jour$) As String
  Application.Volatile
  If Not IsDate(jour) Then Exit Function
  Dim s1$, s2$, p As Byte, a%, b&
  Dim co1%, co2%, col%, lg1&, lg2&, lig&
  p = InStr(plg, ":"): If p = 0 Then Exit Function
  s1 = Left$(plg, p - 1): s2 = Right$(plg, Len(plg) - p)
  With Range(s1): co1 = .Column: lg1 = .Row: End With
  With Range(s2): co2 = .Column: lg2 = .Row: End With
  s2 = "": a = co1 - 1: b = lg1 - 1
  For lig = lg1 To lg2
    If Cells(lig, a) = CDate(jour) Then
      For col = co1 To co2
        s1 = Cells(lig, col)
        If s1 <> "" Then s2 = s2 & Cells(b, col) & " " & s1 & " / "
      Next col
    End If
  Next lig
  If s2 <> "" Then s2 = Left$(s2, Len(s2) - 3)
  NOUV = s2
End Function

c'est ce nouveau code VBA que j'explique ci-dessous.



Function RDV(plg$, nom$) As String : la fonction RDV() reçoit les 2 arguments plg et nom et retourne une chaîne de caractères ; plg est la plage du tableau, et nom est le nom de la personne qui va être cherché dans plg ; pour l'exemple, on va utiliser l'appel de H4 : =RDV("C4:E7";G4) avec en G4 : "Anne" ; plg est donc le texte "C4:E7" ; et nom est "Anne".

Application.Volatile : pour que la fonction soit recalculée chaque fois qu'un calcul est effectué dans une cellule quelconque de la feuille de calcul.

If nom = "" Then Exit Function : si G4 était vide, nom serait vide ➯ la recherche serait inutile ! c'est pourquoi on sort de la fonction si nom est vide ; bien noter que dans ce cas, la valeur de retour de RDV() est inchangée : c'est donc sa valeur par défaut : une chaîne de caractères vide "" ; mais dans le cas présent, nom contient "Anne" ➯ on ne quitte pas la fonction, et on va faire la suite.

Dim s0$, s1$, s2$, p As Byte, a%, b& et Dim co1%, co2%, col%, lg1&, lg2&, lig& : déclaration de plusieurs variables ; Dim s0$ : idem que Dim s0 As String ; Dim a% : idem que Dim a As Integer ; Dim b& : idem que Dim b As Long

p = InStr(plg, ":") : on cherche le signe « : » dans plg (normalement, il doit toujours y en avoir un) ; ici, p vaut 3 car dans "C4:E7", le signe « : » est bien le 3ème caractère ; s'il n'y avait pas eu de signe « : », alors : a) ça aurait signifié que l'utilisateur s'est trompé en indiquant la plage du tableau ; b) p = 0.

If p = 0 Then Exit Function : si y'avait pas de signe « : », alors p = 0 ➯ a) l'utilisateur a indiqué une plage de tableau incorrecte ; b) on quitte la fonction.

s1 = Left$(plg, p - 1) : s1 contient les caractères de gauche de plg qui sont avant le signe « : » ; c'est donc "C4" : la cellule du coin supérieur gauche de la plage du tableau.

s2 = Right$(plg, Len(plg) - p) : s2 contient les caractères de droite de plg qui sont après le signe « : » ; c'est donc "E7" : la cellule du coin inférieur droit de la plage du tableau.

With Range(s1): co1 = .Column: lg1 = .Row: End With : avec la plage s1, donc avec la plage C4 : co1 est le n° de colonne : 3 car C est bien la 3ème colonne ; lg1 est le n° de ligne : 4.

With Range(s2): co2 = .Column: lg2 = .Row: End With : avec la plage s2, donc avec la plage E7 : co2 est le n° de colonne : 5 car E est bien la 5ème colonne ; lg2 est le n° de ligne : 7.

s2 = "" : s2 sera la chaîne résultat ; on l'initialise à "" (car elle avait déjà servi avant, pour contenir "E7") ; a = lg1 - 1 : a contient le n° de la ligne d'en-têtes du tableau : lg1 - 1 = 4 - 1 = 3 ; b = co1 - 1 : b contient le n° de la colonne d'en-têtes du tableau : co1 - 1 = 3 - 1 = 2 (colonne B).

For col = co1 To co2 ... Next col : boucle des colonnes co1 à co2, ici 3 à 5 (colonnes C à E).

For lig = lg1 To lg2 ... Next lig : boucle des lignes 4 à 7.

s1 = Cells(lig, col) : s1 contient la valeur d'une cellule de la plage C4:E7 (cette plage étant lue verticalement, colonne après colonne).​

If s1 <> "" Then : on s'occupe de s1 seulement s'il est non vide ; puis :
If s1 = nom Then : on va mettre à jour s2 seulement si s1 = nom, donc si s1 = "Anne"
s2 = s2 & Cells(a, col) & " " & Cells(lig, b) & " / " : s2 = s2 & le jour de la ligne a (donc de la ligne 3) & un espace & l'heure de la colonne b (donc de la colonne 2) & " / "

If s2 <> "" Then s2 = Left$(s2, Len(s2) - 3) : après les 2 boucles, si s2 n'est pas vide, c'est qu'on n'y a mis au moins une chose, y compris le séparateur " / " ; cette instruction enlève le dernier séparateur " / ".

RDV = s2 : le résultat s2 est mis dans la chaîne de caractères de retour de RDV.​



Function NOUV(plg$, jour$) As String : la fonction NOUV() reçoit les 2 arguments plg et jour et retourne une chaîne de caractères ; plg est la plage du tableau, et jour est la date qui va être cherchée dans la 1ère colonne d'en-têtes du tableau (qui est aussi la 1ère colonne à gauche de la 1ère colonne de plg) ; pour l'exemple, on va utiliser l'appel de H13 : =NOUV("C12:E15";G13) avec en G13 : "05/03/21" ; plg est donc le texte "C12:E15" ; et jour est "05/03/21".

Application.Volatile : pour que la fonction soit recalculée chaque fois qu'un calcul est effectué dans une cellule quelconque de la feuille de calcul.

If Not IsDate(jour) Then Exit Function : si G13 était vide, jour serait vide ; si G13 contenait une date non valide, jour contiendrait une date non valide ; si jour est vide ou si jour contient une date non valide, dans les 2 cas, le test Not IsDate(jour) retourne VRAI ➯ on sort de la fonction car la recherche serait inutile ! bien noter que dans ce cas, la valeur de retour de NOUV() est inchangée : c'est donc sa valeur par défaut : une chaîne de caractères vide "" ; mais dans le cas présent, jour contient "05/03/21" (qui est une date valide) ➯ on ne quitte pas la fonction, et on va faire la suite.

Dim s0$, s1$, s2$, p As Byte, a%, b& et Dim co1%, co2%, col%, lg1&, lg2&, lig& : déclaration de plusieurs variables ; l'explication des divers caractères de type tels que $ % & a déjà été donnée plus haut, lors de l'explication de la 1ère fonction.

p = InStr(plg, ":") : on cherche le signe « : » dans plg (normalement, il doit toujours y en avoir un) ; ici, p vaut 4 car dans "C12:E15", le signe « : » est bien le 4ème caractère ; s'il n'y avait pas eu de signe « : », alors : a) ça aurait signifié que l'utilisateur s'est trompé en indiquant la plage du tableau ; b) p = 0.

If p = 0 Then Exit Function : si y'avait pas de signe « : », alors p = 0 ➯ a) l'utilisateur a indiqué une plage de tableau incorrecte ; b) on quitte la fonction.

s1 = Left$(plg, p - 1) : s1 contient les caractères de gauche de plg qui sont avant le signe « : » ; c'est donc "C12" : la cellule du coin supérieur gauche de la plage du tableau.

s2 = Right$(plg, Len(plg) - p) : s2 contient les caractères de droite de plg qui sont après le signe « : » ; c'est donc "E15" : la cellule du coin inférieur droit de la plage du tableau.

With Range(s1): co1 = .Column: lg1 = .Row: End With : avec la plage s1, donc avec la plage C12 : co1 est le n° de colonne : 3 car C est bien la 3ème colonne ; lg1 est le n° de ligne : 12.

With Range(s2): co2 = .Column: lg2 = .Row: End With : avec la plage s2, donc avec la plage E15 : co2 est le n° de colonne : 5 car E est bien la 5ème colonne ; lg2 est le n° de ligne : 15.

s2 = "" : s2 sera la chaîne résultat ; on l'initialise à "" (car elle avait déjà servi avant, pour contenir "E15") ; a = co1 - 1 : a contient le n° de la colonne d'en-têtes du tableau : co1 - 1 = 3 - 1 = 2 (colonne B) ; b = lg1 - 1 : b contient le n° de la ligne d'en-têtes du tableau : lg1 - 1 = 12 - 1 = 11.

For lig = lg1 To lg2 ... Next lig : boucle des lignes 12 à 15.

If Cells(lig, a) = CDate(jour) Then : si la date de la ligne d'en-têtes du tableau est la même que la date transmise dans jour, alors on exécute la boucle qui suit :

For col = co1 To co2 ... Next col : boucle des colonnes co1 à co2, ici 3 à 5 (colonnes C à E).

s1 = Cells(lig, col) : s1 contient la valeur d'une cellule de la plage C12:E15 (cette plage étant lue horizontalement, ligne après ligne).

If s1 <> "" Then : on s'occupe de s1 seulement s'il est non vide ; puis :
s2 = s2 & Cells(b, col) & " " & s1 & " / " : s2 = s2 & le nom de la ligne d'en-têtes b & un espace & s1 (le chiffre de la plage C12:E15) & " / "

If s2 <> "" Then s2 = Left$(s2, Len(s2) - 3) : après les 2 boucles, si s2 n'est pas vide, c'est qu'on n'y a mis au moins une chose, y compris le séparateur " / " ; cette instruction enlève le dernier séparateur " / ".

NOUV = s2 : le résultat s2 est mis dans la chaîne de caractères de retour de NOUV.


prends tout ton temps pour revérifier si les 2 nouvelles fonctions modifiées retournent bien les résultats attendus, puis pour lire toutes les explications détaillées du code VBA ci-dessus ; bon courage !

soan
 

Pièces jointes

  • RDV.xlsm
    18.2 KB · Affichages: 5

Etoto

XLDnaute Barbatruc
Waw c'est la première fois que je vois une si simple explication pour les fonctions créée par VBA. Bravo
 

anna59

XLDnaute Nouveau
Soan, j'ai essayé de décortiquer ton travail. Wahoo , je sais pas si un jour j'arriver, ça ma l'air d'être compliqué le VBA.
j'ai une petite question, c'est possible d'utiliser la fonction pour un tableau au lieux d'une plage ? Pourrais-je aussi l'utiliser sur deux fichiers différent (dans un il y aurait le tableau, dans l'autre la demande d'info) ?
Merci pour tout le mal que tu as eu pour m'expliquer.
 

soan

XLDnaute Barbatruc
Inactif
Bonsoir anna, le fil,

tu as écrit : « Merci pour tout le mal que tu as eu pour m'expliquer. »

c'est vrai qu'une bonne explication de code VBA est longue à faire, et j'suis content que tu l'aies appréciée ; de même, j'suis content aussi qu'elle aie plu aussi à Etoto (son post #10).



tu as écrit : « c'est possible d'utiliser la fonction pour un tableau au lieu d'une plage ? »

je suppose que tu veux dire pour un tableau structuré (= ListObject en VBA) ; si c'est bien ça, envoie un fichier exemple sans données confidentielles ; j'essayerai de voir si je trouve une solution. (c'est sans garantie)


tu as écrit : « Pourrais-je aussi l'utiliser sur deux fichiers différents ? (dans un il y aurait le tableau, dans l'autre la demande d'info) »

désolé, mais sauf à de très rares exceptions près, je préfère éviter les exos avec plus d'un fichier Excel ; la raison est qu'il y a déjà bien assez à faire avec un seul fichier Excel sans devoir ajouter ce qui concerne le test de présence d'un second fichier ou autre chose du même genre.


tu as écrit : « si dans mon tableau il y aurait des formules dans chaque cellule, alors la fonction prendra l'entête et ajouterait 0 ; exemple : muriel 2 / nathan 8 / mikael 0 »

pour que ce soit plus concret et que je voie mieux ce que ça donnerait, envoie un fichier exemple sans données confidentielles. (là encore, j'donne pas d'garantie qu'j'vais trouver une solution)



tu as écrit : « Si les infos sont récupérées dans un tableau il faut que je modifie ça : ... ? »

là aussi, tu parles d'un tableau structuré (ListObject) ? si oui, même topo : pour que ce soit plus concret, envoie un fichier sans données confidentielles. (exact : j'donne toujours pas de garantie)



si tu envoies plusieurs demandes à la fois, j'essayerai de les faire, mais pas toutes d'un coup ! j'essayerai de les faire l'une après l'autre, et pas forcément dans le même ordre que tes demandes : ce serait plutôt du plus facile et rapide à faire au plus long et difficile à faire, ou selon un goût personnel. (j'suis plus inspiré pour faire telle demande plutôt qu'une autre)

soan
 

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…