Creer une macro excel de recherche?

Version imprimable

04/12/2007, 11h42
doogybreton

Creer une macro excel de recherche?

bonjour, sil vous plait aidez jai vraiment besoin d'aide!

c assez dur a expliquer par ecrit mais je vais essayer de faire simple!

alors voila jai plusieurs fichiers excel contenant une colonne (nommé: "code_var") avec des noms variables (var1, var2, var3) , je voudrai creer une macro qui puisse automatiquement
1/ creer une colonne a coter de celle ci nommer "Correspondance ID"

2/ a partir de cette nouvelle colone il va recherche le noms des variables de la colonne "code_var" au sein d'un tableau (entier et non pas dans une colone spécifique du tableau) d'un autre fichier appeler "references"
NB: ce fichier "references" contient donc un tableau avec en premiere colonne un "numero ID" puis dans les autres colonnes des noms de variables possibles pour chaque ID.

3/lorsqu'il trouve une correspondance de la variable recherché n'importe ou dans le tableau de reference, il faudrai qu'il affiche le numero ID correspondant (en colonne 1) dans la colonne precedement creer du premier fichier "correspondance ID"

NB: la recherche ne doit pas etre stricte, c a dire que si jai un nom de variable a recherché comme "sam" il faut qu'il puisse trouver si elle est affché sam9, 0sam, dans le tableau de reference.MAIS que si je recherche sam2 et que dans le tableau reference il y as ecrit une valeur contenant "sa" ou "am2" il NE Doit ABSOLUMENT PAS MATCHE". En somme, le nom intégral de la valeur sera recherché mais pas stricte

voila, jespere avoir reussi a expliqué clairement mon pb, si vous pensez que c trop compliqué ou quoi que ce soit, dites le au moins, pourvu que je ne reste pas sans réponse.
je vous remercie bcp, c'est vraiment tres tres important pour moi!svp aidezz moiiiii!

PS: je ne peux par contre pas vous envoyer les fichiers car il y a des données confidentiels dessus! dslé!
04/12/2007, 12h15
sash6

va pour la confidentialité mais tu peux envoyer un fichier avec un exemple et d'explications car là c'est pas clair
04/12/2007, 17h08
doogybreton

2 pièce(s) jointe(s)

voila les fichiers

voila les fichiers....

Crosso modo,

il faut en fait qu'il puisse me rechercher la valeur "code-var" dans toutes les colonnes du fichier references et lorsqu'il trouve qu'il me mettent l'ID correspondant.
J'ai 1 fichier qui référence tous les noms de variables possibles appelé "référence"....(c original)
et jai plein plein de fichier constitué tous de la meme manière avec une colonne appelé "code_var"et dont il faut trouver l'ID correspondant..c fichier sappel "fichier1", "fichier2", etc...

voila merci pour votre aidre...il agirait comme une fonction recherchev mais elle rechercherai dans toutes les colonnes

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub recherche()
Dim i As Integer
Dim yacine As Variant
i = 2
Columns("g:g").Select
    Selection.Insert Shift:=xlToRight
While i < 100                            ' selon le nombre de ligne
yacine = Range("f" & i)
 Windows("reference.xls").Activate
 If yacine = Range("f" & i) Then
  Range("a" & i).Select
  Selection.Copy
   Windows("fichier1.xls").Activate
   Range("g" & i).Select
   ActiveSheet.Paste
  End If
 i = i + 1
 Wend
End Sub

05/12/2007, 17h40
doogybreton

euh jy arrive pas ....il y a erreur exeution je pe rien faire...car je comprend pa trop ce a koi correspondent les lignes donc je pe rien changer!
05/12/2007, 18h15
Qwazerty

SAlut
Dis nous au moins sur quelle ligne ca coince, mais je suis pas sur que le code fasse ce que tu souhaite :s
Ce que tu veux faire est assez compliquer, (je ne sais pas quel est ton niveau) et il faudra plus de 10 ligne de code pour tout faire ca c'est certain.
As tu deja realisé des macro?
Si je peux te donner un conseil c'est deja d'enregistrer des macro, tu mance un enregistrement et tu ajoutes ta colonne, tu arrete l'enregistrement et tu vas faire un tour dans vba, tu verra comment vba s'y prend.
ca ne resout pas tout loin de la mais ca donne deja une idée, je la fait souvent.
A++
05/12/2007, 18h20
doogybreton

ben je c pa ..erreur dexecution et le curseur sarrete au debut au niveau du demarrage sub..donc je vois pa trop!!snif!! je men sortirai jamais si ca continue
05/12/2007, 18h22
Qwazerty

Re
Nos message se sont croisé j'ai ajouter des chose sur le precedent.
J'ai pas pas Excel sur mon pc ... ca me gave d'ailleur ... Open office c bien mais ...
D'ailleur ca me gave je vais l'installer de ce pas ... si je trouve mon cd ...
a+
05/12/2007, 18h30
doogybreton

mon niveau au niveau VBA est un pe a chiez, malheureusement...mais jarrive a identifier quelque fonction(meme si jai jamais appris jarrive a me debrouiller en general)...quoi qu'il en soit je suis pa capable d'ecrire un code...
pour enregistrement de macro je connais bien mais de la a lui faire rechercher quelque chose c chiant...il faudrait pe etre ke jarrive a savoir comment retranscrire la fonction recherchev en macro...et aprés modifier celle ci pour kil recherche la valeur non pas ds la premiere colone mais aussi dans les zautre colonnes du tableau egalement, non?

Humm je pense que tu part pas dans la bonne direction,
Je viens d'enregistrer une macro dans cette macro je selectionne ma plage, je fait ctrl+f (fonction recherche) je tape "sam" et j'arrete ma macro et ca donne ca
Code:

1 2 3 4 5 Range("D2:I5").Select Selection.Find(What:="sam", After:=ActiveCell, LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False).Activate End Sub
Je fait un coup de F1 sur Find et dans les exemple je trouve ca

Code:

Set c = .Find(2, lookin:=xlValues)

Ca signifi tu l'auras sans doute compris que c contient toute les cellules repondants a la recherche.

[Edit]
Juste une petite remarque Excel n'est pas un logiciel de base de données, Access seraiyt certainement plus adapté a ce que tu souhaite faire
[/Edit]

re
Alors voila une trame de ce qu'il y a a faire dans cette macro

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
'Il va falloir naviger dans les different fichier (Fichier1,2...,Reference)
 
'1)Lister le fichier du repertoir courant contenant Fichier dans son nom
 
'voir etape6 a mettre ici
 
'2)Faire une boucle sur chaque fichier
 
    '3) controler si la colonne G s'appelle "Corres_ID"
        '3A) Si non
        'On cré une colonne nomé "Corres_ID" + sont formatage
 
        '3B) Si oui
        'On regarde le nombre cellule vide dans la colonne G et on boucle sur chacune d'elles
 
            '4)On recuper pour chaque ligne la valeur de la colonne F ("CODE_VAR")
 
            '5)On va dans Reference.xls
 
            '6)On selectionne la zonne 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
 
            '8A)Si non ... je sais pas mais y'a un soucis (peut etre prendre le n° de ligne qui revient le plus)
 
            '8B)Si oui on recupert la valeur de la colonne A ("N°ID")
 
            '9)On retourne dans Fichierx
 
            '10)On colle la valeur (N° ID) dans la cellule de la ligne en cours

Je pense que c'est pas mal complet regarde et dis moi

05/12/2007, 19h03
doogybreton

ah oki ..oui carrement mieux dintroduire le rechercher dans la fonction macro...
est ce que tu c comment creer une boucle non? parce qu'il faut que chaque ligne soit rechercher.. a moins que ca le fait deja ds le code en haut ds ce cas :aie: je suis irrecuperable!!
05/12/2007, 19h22
doogybreton

ah non oubli javai pa vu le message du dessu qd jecrivais ..on a encore du se croiser^o^ bon je regarrde ce code tout de suite, et je te dit..ca a lair super !!vraiment merci
05/12/2007, 19h36
doogybreton

jai regarder la trame donc je pense que ya des trucs qui seront plus simple

'Il va falloir naviger dans les different fichier (Fichier1,2...,Reference)
"1)Lister le fichier du repertoir courant contenant Fichier dans son nom"
je pense pas besoin de lister fichier de dossier courant , je pars du principe que j'ouvrirai toujour le fichier des reférences(il changera pas) et j'irai manuellement a laide de la macro choisir un des fichiers à annoter)

'3) controler si la colonne G s'appelle "Corres_ID"
dans tous les fichiers a lancer la macro il n'y aura pas de de colonne nommé ID Corresp donc faudrait forcement la creer juste apres la colone nommé "CODE_VAR" (colone F)

'4)On recuper pour chaque ligne la valeur de la colonne F ("CODE_VAR")

'5)On va dans Reference.xls

'6)On selectionne la zone de recherche peut etre a definir au debut de la macro une fois pour toutedefinition de la zone a rechercher peut etre toute la feuille 1 du fichier ref comme ca on est sur du truc

'7)On recupert toutes les cellule qui contiennent le mot
normalement une seul cellule si on met respecter casse sans toutefois avoir totalité du contenu de la cellule

'8)On controle que toute ces celule se trouve sur la meme ligne

'8A)Si non ...on ecrit dans la cellule corresp_id du mot recherché "redondance"

'8B)Si oui on recupert la valeur de la colonne A ("N°ID")

'9)On retourne dans Fichierx
05/12/2007, 20h08
doogybreton

sinon javais une autre idée au niveau de fonction reference je creer une colone (avant la macro) ou jai introduit fonction c1&c2&c3&c4
pour qu'il maffiche tous les noms possible dans une seul cellule c pa possible apres de lui faire recherche dans cette colonne toujour avec recherche et respecter casse mais sans cellule entiere????

Bon alors je te donne pas mon compte paypal mais le coeur y ai :D

Voila pour toi clef en main

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
Sub PointG()
 
Dim PathFile As String
Dim Fichier As Variant
Dim NbrFichier As Integer
 
Dim NomXlsReference As String
 
Dim StrCodeVar As String
Dim firstAddress As String, TmpRow As Integer
 
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
Set PlageREcherche = Range("B2:I" + 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 + "Fichier*.xls")
 
'2)Faire une boucle sur chaque fichier
Do While Fichier <> ""
    DoEvents
 
    If Not (Fichier = "." Or Fichier = ".." Or (GetAttr(PathFile + Fichier) And vbDirectory) <> 0) 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 G s'appelle "Corres_ID"
        If Range("G1").Formula <> "Corres_ID" Then
            '3A) Si non
            'On cré une colonne nomé "Corres_ID" + sont formatage
            Columns("G:G").Select
            Selection.Insert Shift:=xlToRight
            Selection.ClearFormats
            Selection.NumberFormat = "@"
            Range("G1:G" + CStr(NbrLigneFichierX + 1)).Interior.ColorIndex = 40
            Range("G1").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
        For Each CelTmp In Range("F2:F" + CStr(NbrLigneFichierX + 1))
            '4)On recuper pour chaque ligne la valeur de la colonne F ("CODE_VAR")
            StrCodeVar = 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:=StrCodeVar, LookIn:=xlFormulas)
            If Not CelMatch Is Nothing Then
                firstAddress = CelMatch.Address
                TmpRow = CelMatch.Row
                Do
                    If CelMatch.Row <> TmpRow 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"
                    GoTo Redond
                    End If
 
                    Set CelMatch = PlageREcherche.FindNext(CelMatch)
                Loop While Not CelMatch Is Nothing And CelMatch.Address <> firstAddress
            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(TmpRow, 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, 7).Value = NumID
 
        Next CelTmp 'On passe au codeVar suivant
 
    End If
    'On ferme le FichierX + sauvegarde
    ActiveWorkbook.Close SaveChanges:=True
 
    '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

Ca fait tout
Ca recherche la liste de fichier
Si la colonne existe ca la complete
Si elle existe pas ca la crée ET ca la complete

Pour "Redondence" je modifi sur place j'espere ne pas faire de bug ;)

Et voilou c fait
A++
Qwaz

05/12/2007, 21h41
doogybreton

:king::king::king::king:
la vache franchement trop bien ...je ne sais comment te remercier c vraiment génial...si franchement je pourrai en quoi que ce soit te rendre lappareil je le ferai avec plaisir..un grand merci:D

bon je vais essayer de la comprendre un peu quand meme, deja pour pas mourrir idiot et aussi pour pouvoir ladapter si par exemple des noms ou position de colonne venait a changer...merki merki encore:yaisse2:

une petite note japprecie tout particulièrent le nom que tu donne a ta macro ..^o^"
05/12/2007, 22h22
Qwazerty

8-);)

bon excuse moi mais jaurai besoin encore de tes lumières..parce jai pa reussi certains changements au niveau du code ..en effet pour les fichiers que jai envoyé c t des fichiers construit pour cause de confidentialité des données..
du coup lorsque jessaye de changer le code en rapport avec mes fichiers ca marche un pb il semblerait au niveau de letape 8 (que je comprend le moins dailleur) alors voila ta macro refait un peu

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
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, TmpRow As Integer
 
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
Set PlageREcherche = Range("B2:I" + 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) 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 G s'appelle "Corres_ID"
        If Range("J1").Formula <> "Corres_ID" Then
            '3A) Si non
            'On cr?une colonne nom?"Corres_ID" + sont 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
        For Each CelTmp In Range("J2:J" + 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)
            If Not CelMatch Is Nothing Then
                firstAddress = CelMatch.Address
                TmpRow = CelMatch.Row
 
                    Set CelMatch = PlageREcherche.FindNext(CelMatch)
                Loop While Not CelMatch Is Nothing And CelMatch.Address <> firstAddress
            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(TmpRow, 1).Text
 
   '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
 
    End If
    'On ferme le FichierX + sauvegarde
    ActiveWorkbook.Close SaveChanges:=True
 
    '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

donc voila je suis vraiment dsle de te solliciter a nouveau jai tout fait pour ne pas avoir a te redemander ce service...
jai aussi preparer les 2 vrai fichiers preference et lautre a travailler avvec seulement les 3 ou 4 première lignes dafficher (mme c quelque ligne sont censé etre confidentiel et je risque gros au point de vue de ma boite:( aussi je te lenverrai par mail si tu accepte de bien vouloir maider encore une fois) la colonne precedement CODE_VAR sappel en fait GENOTYPE et elle est en I et la colonne a creer et donc en J...
ca je pense avoir reussi sans trop de pb a changé ds le macro reste letape 8 qui pose de gros pb pe etre faut il abandonner la verification des match et supposer que pour chaque recherche il ne trouve qu'une seul valeur yaura donc des erreurs parfois mais bon tanpis ..prend le risk

SAlut
Je regarde vite fait

Code:

Fichier = Dir(PathFile + "*.xls")

Attention, si Reference.xls est dans la meme repertoire il faut pensais a tester ensuite pour ne pas l'ouvrir

Pour le reste je mettrais le code sous excel pour voir comment ca va se compaorter.

Pour la phase 8 je vais t'expliquer c'est tres simple et tu ferais mieux de garder le test au moins ca evitera des erreurs qui peuvent l'etre facilement

Alors

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
             Set CelMatch = PlageREcherche.Find(What:=StrCodeVar, 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
                firstAddress = CelMatch.Address 'on concerve la 1er cellule qui correspond (excel boucle)
                TmpRow = CelMatch.Row 'on concerve le Row de la 1er cellule trouvé
                Do 'Boucle
                    If CelMatch.Row <> TmpRow 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 ala suite
                    End If
 
                    Set CelMatch = PlageREcherche.FindNext(CelMatch) 'On prend la cellule suivant qui correspond a notre recherche du debut
                Loop While Not CelMatch Is Nothing And CelMatch.Address <> firstAddress '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

Apres on utilise la valeur de NumId

Je ma magne je suis a la bourre
a++
QWaz

06/12/2007, 11h27
doogybreton

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

06/12/2007, 14h42
doogybreton

: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