Recherche et renvoi de valeurs

[Haelyn]

Bonjour à tous,

je rencontre quelques difficultés pour un problème relativement simple je pense.
Pour plus de clarté, je met mon fichier test en pj.

Donc, je souhaite pour chaque onglet résultat de mon classeur, chercher la valeur en B1 (Numéro) dans le dernier onglet BDD.
Si je la trouve, alors je reporte chaque nom d'arrêt de la base BDD dans mes cellules en colonne A de mon onglet résultat, seulement si la cellule [arrêt ; colResultat] n'est pas vide.

c'est pas forcément clair 😕 donc j'ai mis un exemple de résultat voulu dans le dernier onglet.

A noter que l'onglet BDD, je le reçois dans cette forme là.
(Il est petit pour que je comprenne le fonctionnement de cette macro, mais en réalité il y a le triple de lignes / colonnes.)
Je ne peux donc pas le modifier.


J'ai volontairement effacé tous mes codes de macros que j'avais écrit pour éviter de comprendre le mic-mac que j'avais testé. Je pense qu'il est plus simple de reprendre à zéro.


J'espère que c'est assez clair 😀

Merci d'avance

 

[R@chid]

Re : Recherche et renvoi de valeurs

Bonjour et Bienvenu sur XLD,
Une solution par Formule Matricielle en A4 :

=SI(LIGNES($4:4)<=SOMME((bdd!B$3:M$16="x")*(bdd!B$19:M$19=B$1));INDEX(bdd!A$3:A$16;MIN(SI((bdd!B$3:M$16="x")*(bdd!B$19:M$19=B$1)*(NB.SI(A$3:A3;bdd!A$3:A$16)=0);LIGNE(INDIRECT("1:"&LIGNES(bdd!A$3:A$16))))));"")

@ valider par Ctrl+Maj+Entree
@ tirer vers le bas
Voir PJ
Amicalement

 

[PMO2]

Re : Recherche et renvoi de valeurs

Bonjour,

Voir l'exemple en pièce jointe.

1) Code évènementiel dans la fenêtre de code de la feuille "test"

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$B$1" Then
  If IsNumeric(Target) And Target <> "" Then Call ProcPMO(CLng(Target))
End If
End Sub

2) Code dans un module standard

'### Constantes à adapter ###
Const FEUILLE_BDD As String = "bdd"
Const SYMBOLE As String = "x"
'############################

Sub ProcPMO(Numero As Long)
Dim S As Worksheet
Dim R As Range
Dim var As Variant
Dim LastRow&
Dim LastCol&
Dim i&
Dim j&
Dim cpt&
Dim ColNum&
Dim bool As Boolean
Dim T()
Set S = Sheets(FEUILLE_BDD)
LastRow& = S.[a65536].End(xlUp).Row
LastCol& = S.Range("iv" & LastRow& & "").End(xlToLeft).Column
Set R = S.Range(S.Cells(1, 1), S.Cells(LastRow&, LastCol&))
var = R
'--- Recherche de la colonne du numéro ---
For j& = 1 To LastCol&
  If var(LastRow&, j&) = Numero Then
    bool = True
    ColNum& = j&
    Exit For
  End If
Next j&
If Not bool Then
  MsgBox "Le numéro " & Numero & " ne figure pas dans la feuille " & FEUILLE_BDD
  Exit Sub
End If
'--- Récupère les "Arret" marqués par le symbole (x en l'occurence) ---
For i& = 1 To LastRow&
  If var(i&, ColNum&) = SYMBOLE Then
    cpt& = cpt& + 1
    ReDim Preserve T(1 To 1, 1 To cpt&)
    T(1, cpt&) = var(i&, 1)
  End If
Next i&
If cpt& = 0 Then    'on sort si aucune occurence n'a été trouvée
  MsgBox "Aucune occurence n'a été trouvée pour le numéro " & Numero
  Exit Sub
End If
'--- Crée une nouvelle feuille ---
Set S = Sheets.Add(after:=Sheets(Sheets.Count))
i& = 0
On Error Resume Next
Do
  Err.Clear
  S.Name = Numero & " (" & i& & ")"
  i& = i& + 1
Loop Until Err = 0
On Error GoTo 0
'--- Inscrit les résultats dans une nouvelle feuille ---
Set R = S.Range("a3:b" & cpt& + 2 & "")
R = Application.WorksheetFunction.Transpose(T)
S.[a1] = "Numéro :"
S.[b1] = Numero
End Sub

UTILISATION
Tapez un numéro dans la cellule B1 de la feuille "test"
Si le numéro existe et comporte des occurrences du symbole "x", une feuille est créée avec le résultat.