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
| Sub Macro_Recherche()
Dim Str_Plage As String
Dim Cel As Range
Dim FeuilSource As Worksheet, FeuilDestination As Worksheet 'Met des noms qui ont un sens c'est plus simple ensuite
Dim Str_critere As String 'pas d'accent sur les variables
Dim X As Byte
Dim Plage_Str As String
Dim destination As String
Dim ANSpos As Integer, Npos As Integer, LongueurChaine As Integer
Dim NumAns As String
'Il faut utiliser des variable pour pointer sur tes fichiers
Dim WbSource As Workbook, WbDestination As Workbook
'ensuite tu les définis
'Nul part dans ton code tu ne défini Source, je suppose donc qu'il faut l'ouvrir
Set WbSource = Workbooks("Source.xls") 'Workbooks.Open("Le chemin de ton fihcier Source")
Set WbDestination = ThisWorkbook
'Str_Plage = "B1:B3"
'Str_critere = "*N* 30 Ans*" 'mot que l'on cherche 'On ira le chercher dans la feuille source
'pour chaque onglet de source
'on lit la cellule B1 avec le texte de la forme "*N* 30 Ans*" ou "*N* 60 Ans*"
'on copie B9:B18
'on active cette feuille
'on recherche le texte dans le fichier destination en cellule B2
'on active cette feuille
'on colle B9
'il faut préciser sur quel classeur tu travailles
'On boucle sur les feuilles du classeur source
For Each FeuilSource In WbSource.Sheets
'Je ne comprend pas, il n'y a bien qu'une seule info en cellule B1, pourquoi faire une boucle
'For Each Cel In Feuil.Range("B1", Feuil.Cells(Feuil.Rows.Count, "B").End(xlUp))
'Par contre il faut maintenant boucler sur les feuilles du classeur Destination
'On va devoir isolé le critére à rechercher, il se trouve entre "N°" et "Ans"
'déjà *N°*
'Je vais détailler pour que ce soit plus simple a comprendre
'On prend la position de ANS
ANSpos = InStr(1, UCase(FeuilSource.Range("B1")), "ANS")
'ANSpos contient la position du A de Ans dans la chaine Acvba N°1 60 Ans Babdfuibba par exemple
'On va pointer le s de Ans, on rajoute donc 2 à la valeur trouvé
ANSpos = ANSpos + 2
'On prend ensuite la position de N°
Npos = InStr(1, UCase(FeuilSource.Range("B1")), "N°")
'Npos pointe sur la position du N
'On regarde la longueur de la chaine qu'il faut lire entre N et s donc
LongueurChaine = ANSpos - Npos + 1
'Ensuite on prend une partie du text Acvba N°1 60 Ans Babdfuibba, pour ne garder que N°1 60 Ans
Str_critere = Mid(FeuilSource.Range("B1"), Npos, LongueurChaine)
'ici on commence a prendre le texte à partie du N (Npos) et on lit le texte de longueur LongueurChaine
'On rajoute les * au début et à la fin
Str_critere = "*" & Str_critere & "*"
For Each FeuilDestination In WbDestination.Sheets
'On regarde si les terme correspondent
If UCase(FeuilDestination.Range("B2")) Like UCase(Str_critere) Then
'Feuil.Activate 'inutile de les activer pour travailler avec
'Cel.Activate
'X = MsgBox("Mot """ & Str_critère & """ trouvé :" & Chr(13) & _
"Sur la feuille : " & Feuil.Name & Chr(13) & _
"à l'adresse : " & Cel.Address(0, 0) & Chr(13) & Chr(13) & _
"Oui : on arrête la recherche" & Chr(13) & _
"Non : on continue la recherche " & Chr(13), vbDefaultButton1 + _
vbQuestion + vbYesNo, "MOT TROUVÉ")
'destination = Feuil.Name & Chr(13) '?
'Le text est trouvé
'On copie donc les données contenu dans source vers les classeur Destination
'Si les donnée sont toujours en B9:B18 on fait comme ça
FeuilSource.Range("B9:B18").Copy FeuilDestination.Range("B9:B18")
'Select Case X
' Case 6
' 'Feuil.Activate
' 'Cel.Activate
' Exit Sub
'
' Case 2
' Exit Sub
'
' Case Else
' 'on fait rien, mais on pourrait
'End Select
'Vu qu'on a trouver une correspondance, on passe à la recherche de la feuille Source suivante
'On pourrait utiliser Exit For, pas exit sub, existe sub quite toute la procédure en cours
'Mais pour pouvoir tester si une correspondance à été trouver on va utiliser
GoTo Trouve
End If
Next
'Lorsque Exit For est appellé, on se retrouve ici, mais on ne sait pas si une correspondance a été trouvée
'Le code qui se trouve ici ne sera executer que si aucune correspondance n'a été trouvée
MsgBox "Pas de correspondance pour la feuille " & FeuilSource.Name & " du classeur Source"
Trouve: 'lorsque goto Trouve est appelé, on se retrouve ici directement, sans executer le code qui se trouve entre Next et Trouve:
'On pass à la feuille source suivante
Next FeuilSource
'MsgBox ("pas trouvé")
End Sub |
Fonction de recherche entre deux classeurs
Répondre avec citation
Tutoriel :
Partager