extraction selon critères sur plusieurs onglets

jlgi

XLDnaute Nouveau
Bonjour,

Je m'occupe de carnets de câbles sur une affaire.
J'en ai un par bâtiment, et le projet comporte 17 bâtiments.
Dans un autre fichier excel, du 2e onglet au 18e, se retrouvent les carnets en liaisons de données.

Dans le premier onglet je souhaite pouvoir lister toutes les liaisons de câbles ayant le même type de câble.
le type de câble recherché sera renseigné en cellule B1 du premier onglet en fonction de mes besoins.

Si quelqu'un pouvait me m'aider ou me dire si cela existe déjà, ce serait super.

D'avance merci
 

Robert

XLDnaute Barbatruc
Bonjour Jlgi, bonjour le forum,

J'imagine que pour toi c'est extrêmement clair mais je doute que tu obtiennes une réponse si tu n'envoies pas un fichier exemple.
Dans un onglet ce que tu as et dans un autre ce que tu voudrais après traitement. Quelques lignes de données suffisent et avec des explications claires tu obtiendra plus de chance d'avoir des réponses...
 

jlgi

XLDnaute Nouveau
Bonjour Jlgi, bonjour le forum,

J'imagine que pour toi c'est extrêmement clair mais je doute que tu obtiennes une réponse si tu n'envoies pas un fichier exemple.
Dans un onglet ce que tu as et dans un autre ce que tu voudrais après traitement. Quelques lignes de données suffisent et avec des explications claires tu obtiendra plus de chance d'avoir des réponses...
merci du conseil, je vais y remédier.
 

jlgi

XLDnaute Nouveau
Tout d'abord merci

La sélection fonctionne, cela me donne le nombre de ligne validant la sélection, mais ca n'affiche pas les bon textes.
En fait, cela affiche le nom de l'onglet dans lequel se trouvent le(s) résultat(s) de la recherche.
 

Robert

XLDnaute Barbatruc
Re,

Avec un fichier c'est tellement plus simple !....
En pièce jointe ton fichier modifié avec un bouton et le code ci-dessous :

VB:
Private Sub CommandButton1_Click() 'au clic du bouton
Dim OA As Worksheet 'déclare la variable OA (Onglet Analyse)
Dim PL As Range 'déclare la variable PL (PLage)
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)
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)

ActiveCell.Select 'enlève le focus au bouton
Set OA = Worksheets("Analyse") 'définit l'onglet OA
If OA.Range("B1").Value = "" Then 'condition : si B1 de l'onglet OA est vide
    MsgBox "Vous devez renseigner le type de câble !" 'message
    OA.Range("B1").Select 'sélectionne B1
    Exit Sub 'sort de la procédure
End If 'fin de la condition
If OA.Range("B2").Value = "" Then 'condition : si B2 de l'onglet OA est vide
    MsgBox "Vous devez renseigner la section du câble !" 'message
    OA.Range("B2").Select 'sélectionne B1
    Exit Sub 'sort de la procédure
End If 'fin de la condition
If Not Range("A7").Value = "" Then 'condition si A7 n'est pas vide
    Set PL = OA.Range("A5").CurrentRegion 'définit la plage PL
    Set PL = PL.Offset(2, 0).Resize(PL.Rows.Count - 2, PL.Columns.Count) 'redéfinit la plage PL (sans les deux première lignes)
    PL.ClearContents 'efface les anciennes données
End If 'fin de la condition
K = 1 'initialise la variable K
For Each O In Sheets 'boucle 1 : sur tous les onglets O du classeur
    If Not O.Name = "Analyse" Then 'condition 1 : si l'onglet O n'est pas l'ongletalyse"
        TV = O.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
        For I = 2 To UBound(TV, 1) 'boucle 2 : sur toutes les lignes I du tableau des valeurs (en partant de la seconde)
            'condition 2 : si la données en ligne I colonne 8 de TV est égale à B1 et la donnée ligne I colonne 7 de TV est égale à B2
            If TV(I, 8) = OA.Range("B1").Value And TV(I, 7) = OA.Range("B2").Value Then
                ReDim Preserve TL(1 To UBound(TV, 2), 1 To K) 'redimensionne le tableau de lignes TL (autant de lignes que TV a de colonnes, K colonnes)
                For J = 1 To UBound(TV, 2) 'boucle 3 : sur toutes le colonne J du tableau des valeurs TV
                    TL(J, K) = TV(I, J) 'récupère dans la ligne J de TL, la donné en colonne I 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 'prochaien onglet de la boucle 1
If K > 1 Then 'condition : si K est supérieur à 1
    'renvoie dans A7 redimensionnée de l'onglet OA le tableau TL transposé
    OA.Range("A7").Resize(UBound(TL, 2), UBound(TL, 1)).Value = Application.Transpose(TL)
Else 'sinon
    MsgBox "Aucune câble de cette section trouvé !" 'message
End If 'fin de la condition
End Sub
 

Fichiers joints

jlgi

XLDnaute Nouveau
Je vous remercie, ca fonctionne très bien et en plus je vais pouvoir apprendre "comment" ça fonctionne

Merci
 

BOISGONTIER

XLDnaute Barbatruc
Bonjour,

Avec une fonction perso(réutilisable)

-Sélectionner A7:I24
=cherche3D2(2;4; B1;" H2:H100";B2;"G2:G100";"A3:I100")
-Valider avec maj+ctrl+entrée


VB:
Function cherche3D2(début, fin, clé1, champRecherche1, clé2, champRecherche2, champBD)
  Application.Volatile
  Dim b()
  nlig = Application.Caller.Rows.Count
  ncol = Application.Caller.Columns.Count
  ReDim b(1 To nlig, 1 To ncol)
  n = 0
  For s = début To fin
    Set f = Sheets(s)
    Tab1 = f.Range(champRecherche1).Value
    Tab2 = f.Range(champRecherche2).Value
    Tab3 = f.Range(champBD).Value
    For lig = 1 To UBound(Tab1)
      If (UCase(Tab1(lig, 1)) = UCase(clé1) Or (clé1 = "*" And Tab1(lig, 1) <> "")) Then
        If UCase(Tab2(lig, 1)) = UCase(clé2) Or (clé2 = "*" And Tab2(lig, 1) <> "") Then
          n = n + 1: If n > nlig Then cherche3D2 = "Pas assez de lignes!": Exit Function
          For k = 1 To ncol:   b(n, k) = Tab3(lig, k): Next k
        End If
      End If
     Next lig
   Next s
   cherche3D2 = b
End Function
Boisgontier
 

Fichiers joints

Dernière édition:

jlgi

XLDnaute Nouveau
Merci pour ces réponses.
J'ai les ai adaptés à mes besoins, testés et ca marche du tonnerre.
il y a juste une rectif dans la fonction perso, ce doit être "A2"
=cherche3D2(2;4; B1;" H2:H100";B2;"G2:G100";"A3:I100")

Encore merci
jlgi
 

Discussions similaires


Haut Bas