XL 2013 recherche dans un classeur

[tit32600]

Bonjour à tous

Je souhaiterais de l’aide, afin de réaliser dans une feuille nommée « Recherche », une recherche d’après une valeur, dans tous mon classeur

Dans mon classeur, j’ai 12 feuilles qui sont nommée en fonction du mois en cours.

« Janvier 2017 », « Février 2017 »………. »Décembre 2017 »

Ces 12 feuilles ont la même structure.
De A4:A110, la date des interventions.
De B4:B110, le N° OT
De C4:C110, le N° d’Avis
De D4110, le N° Intervention
En E4:E110, la description de l’intervention
En F4:F110, le type d’intervention,
En H4:H110, le temps passé.

Dans ma feuille « Recherche », j’ai un tableau avec
En cellule A6 la date à chercher
En cellule B6 le N° OT à chercher
En cellule C6, le N° avis à chercher,
En D6, le N° intervention à chercher.

Si par exemple, j’indique en « A6 », une date à rechercher, avec l’aide d’un bouton « recherche », je souhaiterais, que cette valeur, soit recherchée dans tous mon classeur, et que les différents éléments trouvés, s’affiche dans un tableau, qui se trouve toujours dans ma feuille recherche.

Ce tableau m’indiquera
En A11:A20 la date
En B11:B20 les N°OT correspondant à la date
En C11:C20, les N° Avis correspondant à la date
En D1120 le N° intervention correspondant à la date.

Une seule valeur de recherche sera utilisée.
Merci encore
titi32600

 

[Robert]

Bonsoir Tit, bonsoir le forum,

C'est tellement plus facile avec le fichier qui va bien !...
Essaie lE code ci-dessous à placer dans le composant VBA de l'onglet Recherche :

Private TEST As Boolean 'déclare la variable TEST

Private Sub Worksheet_Change(ByVal Target As Range) 'au changement dans l'onglet
Dim V As Variant 'déclare la variable V (Valeur)
Dim COL As Byte 'déclare la variable COL (COLonne)
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim I As Byte 'déclare la variable I (Incrément)
Dim J As Byte 'déclare la variable J (incrément)
Dim K As Integer 'déclare la variable K (incrément)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)

'si le changement a lieu ailleurs que dans la plage A6:D6, sort de la procédure
If Application.Intersect(Target, Range("A6:D6")) Is Nothing Then Exit Sub
If TEST = True Then Exit Sub 'si TEST est [vrai], sort de la procédure
TEST = True 'définit la variable TEST (évite la boucle sur la procédure SelectionChange)
V = Target.Value 'définit la valeur V
Range("A6:D6").ClearContents 'efface le contenu de la plage A6:D6 (avec d'enventuelles anciennes recherches)
Target.Value = V 'renvoie la valeur V dans la cellule éditée
COL = Target.Column 'définit la colonne COL
TEST = False 'réinitialse la variable TEST
K = 1 'initialise la variable K
For Each O In Sheets 'boucle 1 : sur tous les onglets du classeur
    If Not O.Name = "Recherche" Then 'condition 1 : si le nom de l'onglet O n'est pas "Recherche"
        TV = O.Range("A4:H110") 'définit le tableau des valeurs TV
        For I = 1 To UBound(TV, 1) 'boucle 2 : sur toutes les lignes I du tableau des valeurs TV
            If TV(I, COL) = V Then 'condition 2 : si la donnée ligne I colonne COL de TV est égale à V
                ReDim Preserve TL(1 To 8, 1 To K) 'redimensionne le tableau des lignes TL (8 lignes, K colonnes)
                For J = 1 To 8 'boucle 3 : sur les 8 colonnes du tableau des valeurs TV
                    TL(J, K) = TV(I, J) 'récupère dans la ligne J de TL la donnée en colonne J de TV (= Transposition)
                Next J 'prochaine colonne de la boucle 3
                K = K + 1 'incrémente K (ajoute une colonne au tableau des lignes TL)
            End If 'fin de la condition 2
        Next I 'prochaine ligne de la boucle 2
    End If 'fin de la condition 1
Next O 'prochain onglet de la boucle 1
'si K est supérieuire à 1, renvoie dans la cellule A10 redimensionnée le tableau TL tranposé
If K > 1 Then Range("A10").Resize(UBound(TL, 2), UBound(TL, 1)).Value = Application.Transpose(TL)
End Sub

 

[tit32600]

salut Robert

je t’envoie la mise en forme de mon classeur.

titi32600

 

[tit32600]

Salut Robert

avec l'aide de mon classeur, que si tu entre dans la cellule B6, une valeur de recherche, et si ensuite tu l'efface, tu as une suite de valeurs qui s'affichent depuis A10 jusqu’à A40

 

[Robert]

Bonjour Titi, bonjour le forum,

C'est bien mieux avec un ficher !...

Les modifications par rapport à la première version :
- Code adapté
- Agrandissement du tableau de recherche car si tu tapais visite, par exemple, en E6 ça dépassait grave...
- Harmonisation des tableaux des mois pour qu'ils aient tous la même taille car, contrairement à ce que tu disais, ce n'était pas le cas.
- Suppression les boutons car le code se trouve dans la procédure Change de l'onglet Recherche.

Le code :

Private TEST As Boolean 'déclare la variable TEST

Private Sub Worksheet_Change(ByVal Target As Range) 'au changement dans l'onglet
Dim V As Variant 'déclare la variable V (Valeur)
Dim COL As Byte 'déclare la variable COL (COLonne)
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim I As Byte 'déclare la variable I (Incrément)
Dim J As Byte 'déclare la variable J (incrément)
Dim K As Integer 'déclare la variable K (incrément)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)

'si le changement a lieu ailleurs que dans la plage A6:E6, sort de la procédure
If Application.Intersect(Target, Range("A6:E6")) Is Nothing Then Exit Sub
If TEST = True Then Exit Sub 'si TEST est [vrai], sort de la procédure
TEST = True 'définit la variable TEST (évite la boucle sur la procédure Change)
V = Target.Value 'définit la valeur V
Range("A6:E6").ClearContents 'efface le contenu de la plage A6:E6 (avec d'enventuelles anciennes recherches)
Target.Value = V 'renvoie la valeur V dans la cellule éditée
COL = Target.Column 'définit la colonne COL
TEST = False 'réinitialse la variable TEST
Range("A12:L100").ClearContents 'efface d'éventuelle anciennes données
If Target.Value = "" Then Exit Sub 'si la cellule est effacée, sort de la procédure
K = 1 'initialise la variable K
For Each O In Sheets 'boucle 1 : sur tous les onglets du classeur
    If Not O.Name = "Recherche" Then 'condition 1 : si le nom de l'onglet O n'est pas "Recherche"
        TV = O.Range("A4:L110") 'définit le tableau des valeurs TV
        For I = 1 To UBound(TV, 1) 'boucle 2 : sur toutes les lignes I du tableau des valeurs TV
            If COL = 5 Then 'condition : cas spécial sur la recherche de description (prend en compte une partie edu mot)
                If InStr(1, TV(I, COL), V, vbTextCompare) > 0 Then 'si le texte de V est contenu dans la donnée ligne I colonne COL de TV
                    ReDim Preserve TL(1 To 12, 1 To K) 'redimensionne le tableau des lignes TL (12 lignes, K colonnes)
                    For J = 1 To 12 'boucle 3 : sur les 12 colonnes du tableau des valeurs TV
                        TL(J, K) = TV(I, J) 'récupère dans la ligne J de TL la donnée en colonne J de TV (= Transposition)
                        If J = 1 Then TL(J, K) = DateSerial(Year(TV(I, J)), Month(TV(I, J)), Day(TV(I, J))) 'cas spécial pour les dates
                    Next J 'prochaine colonne de la boucle 3
                    K = K + 1 'incrémente K (ajoute une colonne au tableau des lignes TL)
                End If 'fin de la condition 2
                GoTo suite 'va à l'étiquette "suite"
            End If 'fin de condition du cas spécial recherche de description
            If TV(I, COL) = V Then 'condition 2 : si la donnée ligne I colonne COL de TV est égale à V
                ReDim Preserve TL(1 To 12, 1 To K) 'redimensionne le tableau des lignes TL (11 lignes, K colonnes)
                For J = 1 To 12 'boucle 3 : sur les 12 colonnes du tableau des valeurs TV
                    TL(J, K) = TV(I, J) 'récupère dans la ligne J de TL la donnée en colonne J de TV (= Transposition)
                    If J = 1 Then TL(J, K) = DateSerial(Year(TV(I, J)), Month(TV(I, J)), Day(TV(I, J))) 'cas spécial pour les dates
                Next J 'prochaine colonne de la boucle 3
                K = K + 1 'incrémente K (ajoute une colonne au tableau des lignes TL)
            End If 'fin de la condition 2
suite: 'étiquette
        Next I 'prochaine ligne de la boucle 2
    End If 'fin de la condition 1
Next O 'prochain onglet de la boucle 1
'si K est supérieure à 1, renvoie dans la cellule A12 redimensionnée le tableau TL tranposé
If K > 1 Then Range("A12").Resize(UBound(TL, 2), UBound(TL, 1)).Value = Application.Transpose(TL)
End Sub

Le Fichier :

 

[tit32600]

salut robert

vraiment merci de ton aide.

sans vouloir abuser, j'ai ajouter deux colonnes supplémentaire dans la feuille de recherche
F6 et G6. J'ai un peu modifier ton code, afin de faire une recherche à partir de ces deux critère. ca marche bien

Mon fichier s'ameliorant de jour en jour, j'ai aussi modifié mes feuille mensuelles en y mettant de nouvelle valeurs.
Ma feuille "Recherche à aussi été modifiée.

Seulement au moment de ma recherche, toutes les colonnes ne sont pas renseignées, ex: F:G, et M:N

j'essaye de trouver la solution dans ton code, mais j'ai quelques difficultés

titi32600