Recherche horizontale...possible ?

Bonjour,

je cherche à mettre en place une recherche horizontale assez complexe (pour moi en tout cas ! )

Je vous joint le classeur exposant ma demande...car un exemple vaut mieux qu'un pavé de texte...

Bref je ne sais pas si cela est possible (quoique en VBA tout est possible non ? )

Merci d'avance pour votre aide !

Bonjour,

faut comprendre avec toutes les erreurs de références dans vos explications ! Heureusement les couleurs sont "bonnes" !

La résultat de la recherche en B1 de la valeur C1 dans la plage de la feuil2!A1N20 donne "P" qui est le résultat d'un tirage aléatoire d'une des valeurs des 7 listes trouvées en vert.

@ bientôt

LouReeD

Bonjour,

pas trop compris l'utilité de votre retour...au moins auriez-vous pu me préciser mes "terribles erreurs"...et me dire comment bien rédiger mes explications...non ?

Bref si mes couleurs sont "bonnes" avez vous une piste à me donner histoire d’écrire pour quelque chose et ne pas perdre votre temps ?

Merci

PS : Votre "résumé" sent quand même la mauvaise foi...

Bonjour le fil, bonjour le forum,

Une proposition en pièce jointe avec le code ci-dessous :

Sub Macro1()
Dim O1 As Worksheet 'déclare la variable O1 (Onglet 1)
Dim O2 As Worksheet 'déclare la variable O2 (Onglet 2)
Dim TV1 As Variant 'déclare la variable TV1 (Tableau des Valeurs 1)
Dim TV2 As Variant 'déclare la variable TV2 (Tableau des Valeurs 2)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim K As Integer 'déclare la variable K (incrément)
Dim L As Integer 'déclare la variable L (incrément)
Dim COL As Integer 'déclare la variable COL (COLonne)
Dim NF As Integer 'déclare la variable NF (Nombre de Fois)
Dim NA As Integer 'déclare la variable NA (Nombre Aléatoire)
Dim LI As Integer 'déclare la variable LI (LIgne)

Set O1 = Worksheets("Feuil1") 'définit l'onglet O1
Set O2 = Worksheets("Feuil2") 'définit l'onglet O2
O1.Range("B1:B8").ClearContents 'efface les anciennes données de la colonne B de l'onglet O1
TV1 = O1.Range("B1:C8") 'définit le tableau des valeurs TV1
TV2 = O2.Range("A1:N20") 'définit le tableau des valeurs TV2
For I = 1 To UBound(TV1, 1) 'boucle 1 : sur toutes les lignes I du tableau des valeurs TV1
    'définit le nombre de fois NF que la donnée ligne I colonne 2 de TV1 apparaît dans la plage A1:N20 de l'onglet O2
    NF = Application.WorksheetFunction.CountIf(O2.Range("A1:N20"), TV1(I, 2))
    Randomize 'lance le générateur de nombres aléatoires
    NA = Int((NF * Rnd) + 1) 'définit un nombre aléatoire NA compris entre 1 et NF
    J = 1 'initialise J
    For K = 1 To UBound(TV2, 1) 'boucle 2 : sur toutes les lignes K du tableau des valeurs TV2
        For L = 1 To UBound(TV2, 2) 'boucle 3 : sur toutes les colonnes L du tableau des valeurs TV2
            'si la donnée ligne K colonne L de TV2 est égale à la donnée ligne I colonne 2 de TV1
            If TV2(K, L) = TV1(I, 2) Then
                COL = L 'définit la colonne COL
                J = J + 1 'incrémente J
                If J = NA Then GoTo suite 'si J est égale à NA, va à l'étiquette "suite"
            End If
        Next L 'prochaine colonne de la boucle 3
    Next K 'prochaine ligne de la boucle 2
suite: 'étiquette
    Randomize 'lance le générateur de nombres aléatoires
    LI = Int((8 * Rnd) + 1) 'définit la ligne aléatoire LI ente 1 et 8
    O1.Cells(I, "B").Value = O2.Cells(LI + 20, COL) 'renvoie dans la cellule ligne I colonne B de O1 la valeur de la cellule ligne LI + 20 colonne COL de O2
Next I 'prochaine ligne de la boucle 1
End Sub

Le fichier :

@ Oly80 : Vous avez entièrement raison ! Mais je vous rassure je ne perd jamais mon temps sur Excel-Pratique.com ! C'est un vrai plaisir d'y participer ! Et ce, quelque soit la forme des questions, avec ou sans fichiers, avec ou sans images et explications ! Je pense même faire partie de la petite minorité qui ne s'arrête pas à ce genre de détails. mais il m'arrive parfois de demander des éclaircissements et/ou fichier pour mieux appréhender une solution. Il y a eu comme même plus de 15 téléchargements du fichier... Donc mon intervention permettait peut-être d'être plus précis sur votre demande, mais bien évidemment celle-ci est issue de mon interprétation de votre demande...

Mais bon si vous voyez là de la mauvaise foi, faites comme bon vous semble

J'étais sur une recherche sur formule, mais le "qui s'éclate avec le VBA" a été rapide ! Bonjour ThauThème !

Vous êtes donc entre de bonnes mains, je vous laisser vous éclater ensemble avec du VBA !

@ bientôt

LouReeD

Merci Thauthème ! Je teste cela des que possible mais merci du temps passé sur ce code !

@LouReeD : Sans rancune

bonjour,

Sub alea()

     With Sheets("feuil2")
          arr1 = .Range("A1:N20").Value     'plage1
          arr2 = .Range("A21:N28").Value     'plage2
     End With
     With CreateObject("scripting.dictionary")
          For I = 1 To UBound(arr1)
               For J = 1 To UBound(arr1, 2)
                    If arr1(I, J) <> "" Then .Add .Count, Join(Array("", "V=" & arr1(I, J), "L=" & Format(I, "00"), "C=" & Format(J, "00")), "|")     'toutes les cellules non-vides dans le dictionary avec ligne et colonne
               Next
          Next
          fl = .items     'liste avec toutes ces cellules
     End With

     Set c = Sheets("Feuil1").Range("B1:B8")     'plage3
     c.ClearContents     'effacer
     arr = c.Resize(, 2).Value
     For I = 1 To UBound(arr)     'boucle
          fl1 = Filter(fl, "|V=" & arr(I, 2) & "|", 1, 1)     'filtre ce valeur
          If UBound(fl1) > -1 Then     'il y a des cellules avec ce valeur
               COL = Right(Split(fl1(WorksheetFunction.RandBetween(0, UBound(fl1))), "|")(3), 2)     'colonne aleatoire
               arr(I, 1) = arr2(WorksheetFunction.RandBetween(1, UBound(arr2)), COL)     'ligne aleatoire
          End If
     Next

     c.Value = arr
End Sub

bonsoir,

@Thauthème, une question hors topic, dans votre bouton, le 1ier charactère est souligné. Comment vous avez fait cela ?

Bonsoir,

si je peux me permettre "Accelerator", ceci respecte la casse :

@ bientôt

LouReeD

woow, facile , LouReeD merci

Merci à tous vos formules sont super ! Impressionné