Recherche d'un mot dans une cellule

**MrcRafale** · 14/06/2016, 13h59

Bonjour,

Je suis toujours sur le même fichier, avec des problématiques de plus en plus compliquées (du moins, à mon niveau de débutant)
J'ai toujours mes différentes feuilles traitant chacune d'une date de formation. Il arrive qu'une formation se déroule en plusieurs jours, non consécutifs. J'ai donc possibilité d'avoir des sessions de formations comportant plusieurs modules.
Pour le moment, j'en ai avec 2 ou 3 modules (Dans ce cas, les premiers caractères de la cellule A2 sont "Module x" avec x dans [1;3]) et d'autres avec un seul module (auquel cas je mets directement le sujet et la cellule ne contient pas "module")
Je voudrais pouvoir extraire la liste des présences (NB: Une feuille contient les noms des participants) dans un nouveau fichier, et ce pour chaque session de plusieurs modules.

Le principe physique serait le suivant :
Un bouton lancerait une userform dans laquelle je viendrais sélectionner la session voulue
De cette sélection, je viendrais chercher les noms dans les différentes feuilles pour les coller dans un nouveau fichier, en supprimant les doublons
Ce fichier prendrait le nom de la session (session y) et garderait en mémoire où il a pioché les noms (0 = absent, 1 = présent), avec une colonne par module

Est-ce que je suis compréhensible ou non?

D'avance merci

**parmi** · 14/06/2016, 14h44

Bonjour,

Non, je n'ai rien compris...

Mais tu peux t'intéresser aux diverses fonctions texte: Mid, Left, Right
Et aussi Instr()

Ou encore si tu recherches avec Find, le paramètre xlPart

**eric4459** · 14/06/2016, 16h10

Mc Rafale,
Il y a aussi la fonction Like
Voici un morceau de code que j'ai eu a créer dans le passé où j'utilise "Like" et "Instr"

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Do While WKS.Offset(i - 2, 2) <> ""
    If WKS.Offset(i - 2, 2) Like "*FR_Act1*" Then
        If InStr(WKS.Offset(i - 2, 2), sNom) Then
            If InStr(WKS.Offset(i - 2, 2), sDt) Then
                WKS.Offset(j, 0) = WKS.Offset(i - 2, 2)
            End If
        End If
    End If
i = i + 1
If WKS.Offset(j, 0) = 0 Then
j = j
Else
j = j + 1
End If
Loop

Sinon Parmi a raison, ta demande n'est pas très claire

mais bon, tu es encore apprenti

Eric

**MrcRafale** · 14/06/2016, 16h59

Bonjour,

Désolé si c'est pas clair, j'ai du mal à retranscrire mon besoin...
En gros, je veux récupérer les plages G3:J30 de mon classeur "base de données" à chaque fois que B5 vaut 1 (par exemple), et les copier dans un nouveau classeur qui s'appellerait "Session 1".
Puis faire pareil pour la session 2 quand B5=2, etc.

Est-ce que c'est plus clair ou pas? ^^"

(J'ai réussi à contourner la chaine de caractères qui me gênait, je n'ai plus qu'une cellule avec une valeur numérique)

**parmi** · 14/06/2016, 20h37

As-tu un bout de code de ce que tu as essayé et expliquer ce qui ne va pas comme tu le voudrais ?

**MrcRafale** · 15/06/2016, 08h43

Envoyé par parmi

As-tu un bout de code de ce que tu as essayé et expliquer ce qui ne va pas comme tu le voudrais ?

J'ai ça :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
 
Dim w As Integer
Dim Ligne As Integer
 
 
Private Sub CommandButton1_Click()
'BOUTON OK
 
    For w = 2 To ActiveWorkbook.Worksheets.Count
        If Worksheets(w).Range("B5").Value = TextBox1.Value Then
            Active.Worksheet
            Range("G3:J30").Copy
            Set xlBook = xlApp.Workbooks.Add
            xlBook.SaveAs "essai"
            Range("A2").PasteSpecial
        End If
    Next
End Sub

**backx3** · 15/06/2016, 08h53

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
'déclaration des variables :
Dim Trouve As Range, PlageDeRecherche As Range
Dim lup As Variant, AdresseTrouvee As String
Dim i As Integer, LigneMax As Long
 
    Workbooks(FichierIviz).Activate
        LigneMax = Range("A" & Rows.Count).End(xlUp).Row 'Renseigne la dernière ligne pour l'utiliser dans la boucle
 
            Set PlageDeRecherche = Workbooks(FichierMaj).Worksheets("LUP – QC Délai et Liste Quotidi").Columns(1)
 
            For i = 2 To LigneMax 'Boucle pour la mise à jour : On recherche les lups similaires pour mettre à jour
                                  'leurs données, et les copier à la fin du fichier MaJ si elles n'existent pas déjà
             lup = Workbooks(FichierIviz).Worksheets("LUP – QC Délai et Liste Quotidi").Cells(i, 1) 'ce qu'on cherche
            'méthode find, ici on cherche la valeur exacte (LookAt:=xlWhole)
            Set Trouve = PlageDeRecherche.Cells.Find(what:=lup, LookAt:=xlWhole)
 
         If Trouve Is Nothing Then ' Si la lup n'existe pas, on la colle à la fin du fichier mise à jour
             Workbooks(FichierIviz).Activate
             Workbooks(FichierIviz).Worksheets("LUP – QC Délai et Liste Quotidi").Cells(i, 1).Select
             Range(Selection, Selection.Cells(1, 12)).Copy
             Workbooks(FichierMaj).Worksheets("LUP – QC Délai et Liste Quotidi").Activate
             Range("A1").End(xlDown).Offset(1, 0).PasteSpecial
 
         Else 'Si la lup existe, colle la ligne jusqu'à la dernière colonne renseignée (sans effacer la date prévi)
         Workbooks(FichierIviz).Worksheets("LUP – QC Délai et Liste Quotidi").Activate
         Cells(i, 1).Select
         Range(Selection, Selection.Cells(1, 12)).Copy
         Workbooks(FichierMaj).Worksheets("LUP – QC Délai et Liste Quotidi").Activate
         Trouve.PasteSpecial
         End If
        Set lup = Nothing
        Set Trouve = Nothing
        Next
                 Application.CutCopyMode = False 'vide le presse papier

J'ai ce code là pour un projet, je ne sais pas trop si ça peut t'aider...

**MrcRafale** · 15/06/2016, 09h32

Ca me parait un peu compliqué, je vais plutôt partir sur une feuille de ce classeur.

Je reviens vers vous quand ça marchera (ou pas, d'ailleurs!) pour vous dire comment j'ai fait

**MrcRafale** · 15/06/2016, 15h47

J'ai récupéré tous mes noms dans une feuille, j'ai procédé de la manière suivante :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
Sub MAJ_Noms()
    Ligne = 6
    Sheets("Noms").Select
    Range("A6:D1005").Clear
 
    For w = 3 To ActiveWorkbook.Worksheets.Count - 1
        Do While Cells(Ligne, 1) <> ""
            Ligne = Ligne + 1
        Loop
        Sheets(w).Select
        Range("G3:J30").Select
        Selection.Copy
        Range("A1").Select
        Sheets("Noms").Select
        Cells(Ligne, 1).Select
        Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
        ActiveSheet.Paste
        Range("A1").Select
    Next
    Columns("A:D").Select
    Application.CutCopyMode = False
    ActiveSheet.Range("$A$5:$D$2001").RemoveDuplicates Columns:=Array(1, 2, 3, 4), _
        Header:=xlYes
    Range("A1").Select
    Columns("A:D").Select
    ActiveWorkbook.Worksheets("Noms").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Noms").Sort.SortFields.Add Key:=Range("A2:A195"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Noms").Sort
        .SetRange Range("A5:D2001")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("A1").Select
    Ligne_Sens = 6
    Ligne_Form1 = 6
    Ligne_Form2 = 6
    Ligne_Form3 = 6
    Sheets("Noms").Select
    Range("F6:P1005").Clear
 
    For w = 3 To ActiveWorkbook.Worksheets.Count - 1
        Do While Cells(Ligne_Sens, 6) <> ""
            Ligne_Sens = Ligne_Sens + 1
        Loop
        Do While Cells(Ligne_Form1, 9) <> ""
            Ligne_Form1 = Ligne_Form1 + 1
        Loop
        Do While Cells(Ligne_Form2, 12) <> ""
            Ligne_Form2 = Ligne_Form2 + 1
        Loop
        Do While Cells(Ligne_Form3, 15) <> ""
            Ligne_Form3 = Ligne_Form3 + 1
        Loop
        Sheets(w).Select
 
'SENSIBILISATION DESIGN THINKING
        If Range("A2") = "Sensibilisation design thinking" Then
            Range("G3:H30").Select
            Selection.Copy
            Range("A1").Select
            Sheets("Noms").Select
            Cells(Ligne_Sens, 6).Select
            Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
                SkipBlanks:=False, Transpose:=False
            ActiveSheet.Paste
            Range("A1").Select
            Columns("F:G").Select
            Application.CutCopyMode = False
            ActiveSheet.Range("$F$5:$G$2001").RemoveDuplicates Columns:=Array(1, 2), _
                Header:=xlYes
            Range("A1").Select
            Columns("F:G").Select
            ActiveWorkbook.Worksheets("Noms").Sort.SortFields.Clear
            ActiveWorkbook.Worksheets("Noms").Sort.SortFields.Add Key:=Range("F2:F195"), _
            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            With ActiveWorkbook.Worksheets("Noms").Sort
                .SetRange Range("F5:G2001")
                .Header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With
        End If
'MODULE 1 : FONDAMENTAUX DESIGN THINKING ET CREATIVITE
        If Range("A2") = "Module 1 :  Fondamentaux design thinking et créativité" Then
            Range("G3:H30").Select
            Selection.Copy
            Range("A1").Select
            Sheets("Noms").Select
            Cells(Ligne_Form1, 9).Select
            Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
                SkipBlanks:=False, Transpose:=False
            ActiveSheet.Paste
            Range("A1").Select
            Columns("I:J").Select
            Application.CutCopyMode = False
            ActiveSheet.Range("$I$5:$J$2001").RemoveDuplicates Columns:=Array(1, 2), _
                Header:=xlYes
            Range("A1").Select
            Columns("I:J").Select
            ActiveWorkbook.Worksheets("Noms").Sort.SortFields.Clear
            ActiveWorkbook.Worksheets("Noms").Sort.SortFields.Add Key:=Range("I2:I195"), _
            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            With ActiveWorkbook.Worksheets("Noms").Sort
                .SetRange Range("I5:J2001")
                .Header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With
        End If
'MODULE 2 : BUSINESS MODEL
        If Range("A2") = "Module 2 :  Business Model" Then
            Range("G3:H30").Select
            Selection.Copy
            Range("A1").Select
            Sheets("Noms").Select
            Cells(Ligne_Form2, 12).Select
            Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
                SkipBlanks:=False, Transpose:=False
            ActiveSheet.Paste
            Range("A1").Select
            Columns("L:M").Select
            Application.CutCopyMode = False
            ActiveSheet.Range("$L$5:$M$2001").RemoveDuplicates Columns:=Array(1, 2), _
                Header:=xlYes
            Range("A1").Select
            Columns("L:M").Select
            ActiveWorkbook.Worksheets("Noms").Sort.SortFields.Clear
            ActiveWorkbook.Worksheets("Noms").Sort.SortFields.Add Key:=Range("L2:L195"), _
            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            With ActiveWorkbook.Worksheets("Noms").Sort
                .SetRange Range("L5:M2001")
                .Header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With
        End If
'MODULE 3 : BUSINESS PLAN
        If Range("A2") = "Module 3 :  Business Plan" Then
            Range("G3:H30").Select
            Selection.Copy
            Range("A1").Select
            Sheets("Noms").Select
            Cells(Ligne_Form3, 15).Select
            Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
                SkipBlanks:=False, Transpose:=False
            ActiveSheet.Paste
            Range("A1").Select
            Columns("O:P").Select
            Application.CutCopyMode = False
            ActiveSheet.Range("$O$5:$P$2001").RemoveDuplicates Columns:=Array(1, 2), _
                Header:=xlYes
            Range("A1").Select
            Columns("O:P").Select
            ActiveWorkbook.Worksheets("Noms").Sort.SortFields.Clear
            ActiveWorkbook.Worksheets("Noms").Sort.SortFields.Add Key:=Range("O2:O195"), _
            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            With ActiveWorkbook.Worksheets("Noms").Sort
                .SetRange Range("O5:P2001")
                .Header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With
        End If
    Next
    Sheets("Noms").Select
    Range("A1").Select
 
'TRACE DES BORDURES
    'Réattribution de la valeur réelle des variables de ligne
    Ligne_Sens = Ligne_Sens - 1
    Ligne_Form1 = Ligne_Form1 - 1
    Ligne_Form2 = Ligne_Form2 - 1
    Ligne_Form3 = Ligne_Form3 - 1
 
    'Bordures du tableau de sensibilisation
    Range(Cells(6, 6), Cells(Ligne_Sens, 7)).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
 
    'Bordure du tableau du Module 1
    Range(Cells(6, 9), Cells(Ligne_Form1, 10)).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
 
    'Bordure du tableau du Module 2
    Range(Cells(6, 12), Cells(Ligne_Form2, 13)).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
 
    'Bordure du tableau du Module 3
    Range(Cells(6, 15), Cells(Ligne_Form3, 16)).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Range("A1").Select
End Sub

C'est probablement un peu barbare mais ça fonctionne, et le PC n'a pas l'air de prendre trop cher

Par contre, je rencontre un nouveau problème : je veux comparer des listes de noms.
SI un nom apparait une fois dans chaque liste, c'est très bien. Sinon, je veux l'afficher dans une colonne à côté.
J'ai essayé des boucles diverses et variées mais aucune ne me donne ce que je veux...

**parmi** · 15/06/2016, 15h48

Partant de ton code, j'y vois quelques bizarreries...
Voici comment je le modifierais (sans tester...)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Private Sub CommandButton1_Click()
'BOUTON OK
 
    For w = 2 To ActiveWorkbook.Worksheets.Count
        If Worksheets(w).Range("B5").Value = TextBox1.Value Then
            '<s>Active.Worksheet</s>   'pas bon ça...
            Worksheets(w).Range("G3:J30").Copy  'mettre le nom de l'onglet à copier
            Set xlBook = xlApp.Workbooks.Add      'création d'un classeur vierge
            xlBook.Activesheet.Range("A2").PasteSpecial   'Collage des données
            xlBook.SaveAs Thisworkbook.Path & "\essai" & textbox1.value & ".xlsx"  'sauvegarde dans le même dossier que l'application
            Application.Cutcopymode = False  'enlève la surbrillance de la copie pour éviter les messages
            xlBook.Close false   'fermeture de ce nouveau classeur
            Set xlBook = Nothing  'Vide l'espace mémoire réservé à la variable
        End If
    Next
End Sub

**MrcRafale** · 15/06/2016, 16h08

Merci, je vais regarder ça mais je pense que c'est plus simple, au final, de garder la feuille dans le même classeur, comme ça le fichier est autoporteur.
Je clos cette discussion, et j'en ouvre une autre pour mon autre question, histoire qu'on mélange pas tout...

Merci à tous pour vos idées, qui m'ont fait avancer!!

Recherche d'un mot dans une cellule

Macros et VBA Excel

Discussions similaires

Partager

Partager