Besoin d'aide pour un "recherche-coller"

rainbow69006

XLDnaute Occasionnel
Bonjour

Je souhaiterais creer un genre de fonction recherche, qui recherche dans mes pages un mot speifie et me copie une partie de la colonne dans une feuille de resultat.

Comme un exemple vaut mieu qu'un long discours je vous joint un fichier avec plus d'expliquations

Merci:)
 

Pièces jointes

  • essai.xls
    36 KB · Affichages: 64
  • essai.xls
    36 KB · Affichages: 66
  • essai.xls
    36 KB · Affichages: 68

rainbow69006

XLDnaute Occasionnel
Re : Besoin d'aide pour un "recherche-coller"

Bonjour Skoobi
Merci skoobi

C'est exactement ce que je voullais. Par contre est il possible que dans ton programe on specifie la feuille 1 2et 3 parce que en fait ton programe marche impeccablement, le probleme c'est que je joint ton programe a un classeur existant (donc avec d'autres feuilles a l'interieur) et donc ton programe ne sais pas ou chercher les donnes.

par exemple au lieu d'aller les chercher dans la feuille1 il va les chercher dans une de mes feuilles "calcul".

Merci de ton aide
 

skoobi

XLDnaute Barbatruc
Re : Besoin d'aide pour un "recherche-coller"

Re bonjour,

Que veux-tu dire par "je joint ton programe a un classeur existant"?
Actuellement la macro analyse les 3 1ere feuille (quel que soit le nom de ces feuilles).
Ce n'est pas toujours le cas?
Soit plus précis dans ta demande.
 

rainbow69006

XLDnaute Occasionnel
Re : Besoin d'aide pour un "recherche-coller"

Merci skoobi en fait j'ai legerement arranger mon fichier et cela marche bien maintenant.

J'ai joint un fichier je voudrais savoir si il est possible de faire la meme chose mais pour 2 liste deroulante (j'ai mis plus d'expliquations dans le fichier joint)


Petite question supplementaire. dans la liste deroulante que j'ai sur ma feuille:
il y aura le nom de la marque suivi du nom du model ex: Airbus A347
et moi j'ai des dossiers photos du type c:\airbus\Airbus A347\feuille1

Est ce que c'est possible que quand je choisis airbus A347 dans la liste deroulante alors sa m'affiche sur ma page excel une photo qui se trouve dans le dossier c:\airbus\Airbus A347\feuille1 , une autre qui se trouve dans le dossier c:\airbus\Airbus A347\feuille2 et finalement une qui se trouve dans le dossier c:\airbus\Airbus A347\feuille3 ?

Merci beaucoup
 

Pièces jointes

  • book.zip
    16.3 KB · Affichages: 34
  • book.zip
    16.3 KB · Affichages: 31
  • book.zip
    16.3 KB · Affichages: 32
Dernière édition:

skoobi

XLDnaute Barbatruc
Re : Besoin d'aide pour un "recherche-coller"

Re,

que veux-tu dire par:
"alors sa m'affiche sur ma page excel une photo qui....."
Insérer une image dans le fichier?
Si oui, où ça?
Y aurat-il toujours 3 images à chaque fois dans 3 dossiers avec toujours la même structure?
 

rainbow69006

XLDnaute Occasionnel
Re : Besoin d'aide pour un "recherche-coller"

RE Oui c'est bien cela.

Je veu inserer quatre photo chaque photo se trouvant dans un dossier ayant quasi la meme structure.

Je joint dans mon nouveau fichier la position des photos et leur emplacements

Merci Skoobi
 

Pièces jointes

  • book2.zip
    16.5 KB · Affichages: 30
  • book2.zip
    16.5 KB · Affichages: 29
  • book2.zip
    16.5 KB · Affichages: 33

skoobi

XLDnaute Barbatruc
Re : Besoin d'aide pour un "recherche-coller"

Re,

voici le code (en entier) pour 2 liste déroulantes:

Code:
Private Sub ComboBox1_Change()

End Sub

Private Sub ComboBox2_Change()
Range("B10:B21").ClearContents
Range("E10:E21").ClearContents
Range("H10:H21").ClearContents
col = 2
For f = 1 To 3
    With Sheets(f)
        Set marque = Sheets(f).Cells.Find(ComboBox1.Value, LookIn:=xlValues)
        Set modele = Sheets(f).Cells.Find(ComboBox2.Value, LookIn:=xlValues)
        If Not marque Is Nothing And Not modele Is Nothing Then
            If marque.Address = modele.Address Then .Range(marque, marque.Offset(12, 0)).Copy Sheets("page per models").Cells(10, col)
        End If
        col = col + 3
    End With
Next
End Sub

Private Sub Worksheet_Activate()
ComboBox1.Clear
With Sheets("feuille4")
    For Each cellule In .Range(.[A1], .[A1].End(xlDown))
        ComboBox1.AddItem cellule.Value
    Next
End With
ComboBox2.Clear
With Sheets("feuille4")
    For Each cellule In .Range(.[B1], .[B1].End(xlDown))
        ComboBox2.AddItem cellule.Value
    Next
End With

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

End Sub
 

rainbow69006

XLDnaute Occasionnel
Re : Besoin d'aide pour un "recherche-coller"

Super!!

Est il possible par contre:
- d'eviter les doublons dans la combobox1 (En sachant que j'ai deja la liste des marques et que je ne vais jamais en rajouter ou en supprimer)
- dans la combobox 2 de ne pouvoir selectioner que les modeles qui vont avec les marques: ex: lorsque l'on a selectioner dans la combobox1 "airbus" ne pouvoir selectionner que les modeles airbus dans la combobox2 ?


Pour ce qui est de la 2eme question (a propos des photos) je tient a preciser que les photos n'ont pas de nom donc que l'on prendra nimporte quelle photo dans le dossier. Je tient a preciser aussi que dans certain cas il n'y aura pas de photos

Merci de ton aide skooobbbiii!!!

PS: pour ce qui est de la supression des doublons j'avais penser a cela mais apparement c'est pas encore cela. (sa me met une erreur sur la ligne en gras)


Private Sub Worksheet_Activate()
'création de la liste
With Sheets("feuille4")
For Each cel In .Range(.[A2], .[A2].End(xlDown))
On Error Resume Next
liste.Add cel.Value, cel.Value 'cré la liste "sans doublons"
Next
On Error GoTo 0
End With
For Each v In liste
ComboBox1.AddItem liste(v) 'ajoute la liste au combobox
Next
For i = 1 To liste.Count
liste.Remove 1 'vide la liste pour pouvoir en recréer une autre
Next
End Sub
 
Dernière édition:

skoobi

XLDnaute Barbatruc
Re : Besoin d'aide pour un "recherche-coller"

Re bonjour,

PS: pour ce qui est de la supression des doublons j'avais penser a cela mais apparement c'est pas encore cela. (sa me met une erreur sur la ligne en gras

Il faut déclarer la "liste" en début de macro:
Code:
Dim liste As New Collection

dans la combobox 2 de ne pouvoir selectioner que les modeles qui vont avec les marques: ex: lorsque l'on a selectioner dans la combobox1 "airbus" ne pouvoir selectionner que les modeles airbus dans la combobox2 ?

VBA peut faire plein de chose mais pas deviner que A380 correspond à airbus par exemple.
Il faudrait que tu faces des listes modèles distinctes qui seront "chargées" en fonction de la marque par exemple.

Pour ce qui est de la 2eme question (a propos des photos) je tient a preciser que les photos n'ont pas de nom donc que l'on prendra nimporte quelle photo dans le dossier. Je tient a preciser aussi que dans certain cas il n'y aura pas de photos

Piouuu, pas simple tout ça....
 

skoobi

XLDnaute Barbatruc
Re : Besoin d'aide pour un "recherche-coller"

Re,

voici le code du 2eme menu déroulant modifié pour l'insertion des images:

Code:
[B]Private Sub ComboBox2_Change()[/B]
Range("B10:B21").ClearContents
Range("E10:E21").ClearContents
Range("H10:H21").ClearContents
col = 2
For f = 1 To 3
    With Sheets(f)
        Set marque = Sheets(f).Cells.Find(ComboBox1.Value, LookIn:=xlValues)
        Set modele = Sheets(f).Cells.Find(ComboBox2.Value, LookIn:=xlValues)
        If Not marque Is Nothing And Not modele Is Nothing Then
            If marque.Address = modele.Address Then .Range(marque, marque.Offset(12, 0)).Copy Sheets("page per models").Cells(10, col)
        End If
        col = col + 3
    End With
Next
[COLOR=Blue][B]With Application.FileSearch
    .SearchSubFolders = True
    .LookIn = "c:\" & ComboBox1.Value & "\" & ComboBox2.Value
    .Filename = "*.bmp"
    .Execute
    If .FoundFiles.Count > 0 Then
        For num = 1 To .FoundFiles.Count
            Select Case num
            Case 1: Range("B25").Select
            Case 2: Range("E25").Select
            Case 3: Range("B37").Select
            Case 4: Range("B37").Select
            End Select
            ActiveSheet.Pictures.Insert (.FoundFiles(num))
        Next
    End If
End With[/B][/COLOR]

End Sub

.Filename = "*.bmp" est à adapter bien sur.

A tester.
 

rainbow69006

XLDnaute Occasionnel
Re : Besoin d'aide pour un "recherche-coller"

Merci skoobi je vais regarder sa .

Pour ce qui est de la suppressions des doublons et que sa me mette automatiquement les modeles par rapport au marque j'ai retrouver un code que j'utilisais pour une autre partie de mon programe.
Celui la marche impeccablemet seul probleme dans ce programe les combobox sont dans un user form et dans ce que je veu faire les combobox sont directement sur une page. Il doit y avoir quasi rrien a modifier (je pense que ce qui est en gras) seul hic je ne sais pas par quoi le remplacer.

merci de ton aide


Dim DerliF As Integer, DerliG As Integer, DerliH As Integer, DerliI As Integer, DerliJ As Integer
Dim DerliK As Integer, DerliL As Integer, DerliM As Integer, DerliN As Integer, DerliO As Integer
Dim DerliP As Integer, DerliQ As Integer, DerliR As Integer, DerliS As Integer, DerliT As Integer
Dim DerliU As Integer, DerliV As Integer, DerliW As Integer, DerliX As Integer, DerliY As Integer
Dim DerliZ As Integer, DerliAA As Integer, DerliAB As Integer, DerliAC As Integer, DerliAD As Integer
Dim DerliAE As Integer, DerliAF As Integer, DerliAG As Integer, DerliAH As Integer, DerliAI As Integer
Dim DerliAJ As Integer, DerliAK As Integer, DerliAL As Integer, DerliAM As Integer
Dim premièreli As Integer, li As Integer, n As Byte, no As Integer

Dim plage As Range, cell As Range, nv As Byte


Private Sub UserForm_Initialize()
With Sheets("Donnee")
DerliF = .Range("F65536").End(xlUp).Row
DerliG = .Range("G65536").End(xlUp).Row
etc..

ComboBox1.List = .Range("F2:F" & DerliF).Value
End With
ComboBox2.Enabled = False 'interdit la 2ème liste
End Sub

Private Sub ComboBox1_Change()
ComboBox2.Enabled = True 'autorise la 2ème liste
With Sheets("Donnee")
If ComboBox1.Value = "airbus" Then ComboBox2.List = .Range("G2:G" & DerliG).Value
If ComboBox1.Value = "eurocopter" Then ComboBox2.List = .Range("H2:H" & DerliH).Value
etc...

End With
End Sub
 

rainbow69006

XLDnaute Occasionnel
Re : Besoin d'aide pour un "recherche-coller"

Mmmm

Bizare de chez bizare c'est exactement ce que j'avais fais et sa ne marchait pas et maintenant sa marche Mmm

La magie de l'informatique :)

Maintenant je n'ai "plus qu'a" incorporer ton code pour les images

Merci de ton aide (je parle pour tout les coup de mains que tu m'a donne)
 

Discussions similaires

Réponses
2
Affichages
195

Statistiques des forums

Discussions
312 343
Messages
2 087 442
Membres
103 546
dernier inscrit
mohamed tano