Creer une macro excel de recherche?

voila je tai envoyé le fichier ce matin sur ton mail hotmail...

pour le ligne de macro *.xls si je changé seulement ca ..sans introduire d'autres changements ca avait lair de marché et le fichier refenreces netait pas touché car il etait deja ouvert..je pense

SAlut
Bien recu ton mail, voila les modifsJ'ai corrigé 2/3 trucs que j'avais fait et qui etaient pas top, voir meme faux :)
J'ai egalement corrigé les appelles au differentes colonnes, attention en modifiant de pas en oublier ;)
Voila le resultat

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
Sub PointG()
 
Dim PathFile As String
Dim Fichier As Variant
Dim NbrFichier As Integer
 
Dim NomXlsReference As String
 
Dim StrGenotype As String
Dim firstAddress As String, TmpCelRow As Range
 
Dim NumID As String
 
Dim PlageREcherche As Range, CelTmp As Range, CelMatch As Range
Dim NbrLigneFichierX As Integer
 
'Initialisation des variables
'NomXlsReference = "Reference(verion 1).xls"
NomXlsReference = ActiveWorkbook.Name
 
'On ne veut pas que l'utilisateur vois tout les etapes
Application.ScreenUpdating = False
 
'Il va falloir naviger dans les differents fichier (Fichier1,2...,Reference)
 
'xx voir etape6 a mettre ici
Windows(NomXlsReference).Activate
'plage de recherche de la colonne C a H sur x lignes
Set PlageREcherche = Range("C2:H" + CStr(Range("A2").End(xlDown).Row))
 
'1)Lister le fichier du repertoir courant contenant Fichier dans son nom
PathFile = ActiveWorkbook.Path
If Right(PathFile, 1) <> "\" Then PathFile = PathFile + "\"
Fichier = Dir(PathFile + "*.xls")
 
'2)Faire une boucle sur chaque fichier
Do While Fichier <> ""
    DoEvents
 
    If Not (Fichier = "." Or Fichier = ".." Or (GetAttr(PathFile + Fichier) And vbDirectory) <> 0 Or Fichier = NomXlsReference) Then 'normalement inutil ici mais bon ...
        'On ouvre le fichier
        Workbooks.Open Filename:=(PathFile + Fichier)
 
        'On recupert le nombre de ligne du fichier
        NbrLigneFichierX = Range("A1").End(xlDown).Row - 1 '-1 pour ne pas compter les entetes de colonnes
 
        '3) controler si la colonne J s'appelle "corres_ID"
        If Range("J1").Formula <> "corres_ID" Then
            '3A) Si non
            'On cré une colonne nomé "Corres_ID" + son formatage
            Columns("J:J").Select
            Selection.Insert Shift:=xlToRight
            Selection.ClearFormats
            Selection.NumberFormat = "@"
            Range("J1:J" + CStr(NbrLigneFichierX + 1)).Interior.ColorIndex = 40
            Range("J1").Formula = "corres_ID"
        End If
 
 
        '3B) Si oui (ou si on vient de la créé
        'On regarde le nombre cellule vide dans la colonne G et on boucle sur chacune d'elles
        'Ici la colonne I
        For Each CelTmp In Range("I2:I" + CStr(NbrLigneFichierX + 1))
            '4)On recuper pour chaque ligne la valeur de la colonne F ("Genotype")
            StrGenotype = CelTmp.Formula
 
            '5)On va dans Reference.xls
            Windows(NomXlsReference).Activate
 
            '6)On selectionne la zone de recherche peut etre a definir au debut de la macro une fois pour toute
 
            '7)On recupert toutes les cellule qui contiennent le mot
            '8)On controle que toute ces celule se trouve sur la meme ligne
            Set CelMatch = PlageREcherche.Find(What:=StrGenotype, LookIn:=xlFormulas) 'on recherche les cellules qui contiennent le mot strGenoType
            If Not CelMatch Is Nothing Then 'on verrifie que le resultat est pas vide
                Set TmpCelRow = CelMatch 'on concerve la 1er cellule trouvée
                Do 'Boucle
                    If CelMatch.Row <> TmpCelRow.Row Then  'Huston on a un probleme, a toi de voir ce que tu veux faire dans un tel cas
                    '8A)Si non ... je sais pas mais y'a un soucis (peut etre prendre le n° de ligne qui revient le plus)
                    'Ok on note redondance dans la case
                    NumID = "Redondance" '(NumID prend la valeur "Redondance" si la cellule trouvé n'est pas sur la meme ligne que la 1ere
                    GoTo Redond 'Inutile d'aller plus loin on passe a la suite il y a au moins 2 elements sur 2 lignes differentes
                    End If
 
                    Set CelMatch = PlageREcherche.FindNext(CelMatch) 'On prend la cellule suivant qui correspond a notre recherche du debut (equivalent du bouton suivant dans la fenetre de recherche (ctrl+F)
                Loop While Not CelMatch Is Nothing And CelMatch.Address <> TmpCelRow.Address 'On boucle si cellule nopn vide et adresse encors differente de la 1ere(Excel boucle sur les cellule qui corresponde a la recherche fait un essai avec Ctrl+f tu vas comprendre)
            End If
            '8B)Si oui on recupert la valeur de la colonne A ("N°ID")
            ' Ou si on a regler le probleme avant
            NumID = Cells(TmpCelRow.Row, 1).Text
Redond:
            '9)On retourne dans Fichierx
            Windows(Fichier).Activate
 
            '10)On colle la valeur (N?ID) dans la cellule de la ligne en cours et colonne G
            Cells(CelTmp.Row, 10).Value = NumID
 
        Next CelTmp 'On passe au codeVar suivant
 
        Range("A1").Select
 
        'On ferme le FichierX + sauvegarde
        ActiveWorkbook.Close SaveChanges:=True
 
    End If
 
    'On rebascule sur Reference.xls
    Windows(NomXlsReference).Activate
 
    'On passe au fichier suivant qui correspond aux criteres
    Fichier = Dir
Loop ' Et on recommence pour le fichier suivant
 
End Sub

A++
Qwaz

:yaisse2: je ne sais pa ca fait combien de fois que je remercie..mais une fois de plsu ca peut pas faire de mal...:king:
alors un grand merci pour ton aide et le temps que tu as bien voulu maccorder...:lol:

Une fois le projet terminé c sur je me lance dans lapprentissage du VBA :mouarf: pour que puisse au faire des choses par moi meme