Isoler deux termes d'une même cellule

**nicdodo** · 07/04/2015, 10h25

Bonjour,

Grace à excel j'ai récupérer les données d'un site web pour une petit appli que je fais avec excel en vba. j'ai besoin de récupérer certaines données de ce site pour totalement automatiser mon petit programme.

J'ai trouvé un tuto qui m'explique comment récupérer les données d'un site web, l'astuce étant de trouver un point commun aux infos que l'on veut sélectionner et grâce à ça faire un copier coller sous condition.

Sur le site dont j'ai besoin lorsque j'extraie les données du site vers excel je trouve un point commun entre toutes les données masi je ne sais pas comment le demander en vba

En exemple je vais utiliser une foret
Dans une foret il y'a A1 = arbres 12 / A2 fleurs 14 etc

En fait moi j'ai juste besoin du chiffre 12 et 14 sachant que 12 et 14 sont en rouges sur le site et arbres et fleurs en noirs

Comment puis je sélectionner juste le chiffre 12 et 14 en utilisant leur couleur rouge s'il vous plait?

Merci d'avance, cordialement

**antonysansh** · 07/04/2015, 11h12

Bonjour nicdodo,

Je ne sais pas comment récupérer la couleur de certain caractère d'une chaine mais si toutes tes cellules sont de la forme : [un mot][un espace][un nombre]
Tu peux utiliser le code suivant :

Code :

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

1
2
3
4
5
6
7
8
Sub test()
 
Dim rg As Range
Set rg = ActiveSheet.[A1]
 
rg.Value = Right(rg.Value, (Len(rg.Value) - InStr(rg.Value, " ")))
 
End Sub

**nicdodo** · 07/04/2015, 11h52

Merci pour la réponse je vous envoi le fichier joint pour que vous ayez plus de précision. En fait il faudrait que les nombre en rouges se copie coller de la feuille temp à partir de la première ligne de la feuille Accueil, je n'ai pas forcement besoin que les nombres de RESULTAT par exemple soit en colonne A,B et C ils peuvent juste etre à la suite, je trierai les données par la suite. J'ai juste besoin d'une méthode qui me supprime tous à part les nombres en rouge.

Mon code qui ne fonctionne pas et celui ci: (je vous le copie pour que vous voyez à peu prés dans l'idée ce que je souhaite faire)

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
Sub Macro1()
'
' Macro1 Macro
'
 
'Dim rg As Range
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;https://www.betclic.fr/monaco-montpellier-m898436", Destination:=Sheets("temp").Range("$A$1"))
        .Name = "monaco-montpellier-m898436"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = False
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingAll
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
ActiveSheet("temp").Select    
Set rg = ActiveSheet.["A1:F800"]
    compteur = 0
    For i = 1 To 800
    For e= 1 To 7
 
    If rg.Value = Right(rg.Value, (Len(rg.Value) - InStr(rg.Value, " "))) Then
    Sheets("accueil").Cells(compteur, 1) = Sheets("temp").Cells(i, e)
 
Next
Next    
End Sub

Cordialement

**antonysansh** · 07/04/2015, 13h30

Voilà un code qui cette fois remplace le contenu des cellules d'un range (ici [C2:C21]) par uniquement le contenu en rouge :

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
Sub garder_texte_rouge()
    Dim rg As Range: Dim cellule As Range: Dim i As Double: Dim j As Double: Dim res As String
    Set rg = [C2:C21]
 
    For Each cellule In rg.Cells
        res = ""
        j = Len(cellule.Value)
        For i = 1 To j
            If cellule.Characters(i, 1).Font.Color = 255 Then
                res = res & cellule.Characters(i, 1).Caption
            End If
        Next i
        With cellule
            .Value = res
            .Font.Color = 255
        End With
    Next
End Sub

Le problème est que s’il n'y a pas de caractère en rouge, ta cellule devient vide.
Et j'ai choisi le code couleur 255, tu n'as peut être pas le même rouge.

Ça peut au moins te mettre sur la route.

**nicdodo** · 07/04/2015, 15h50

En fait je vais faire par une autre méthode un peu plus longue je pense mais je vais déjà dégrossir mon fichier en essayant de sélectionner les cellules contenant des donnés avec des chiffres. Donc l'idée c'est de chercher dans la 1er colonne de la feuille "accueil" toutes les cellules contenant des chiffres et de copier chaque cellules contenant un chiffre à la suite à la 1er ligne vide de la 1er colonne de la feuille "test". Le problème c'est que mon code ne fonctionne pas

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
 
Sub test()
Dim numlignevide As Integer
 
numlignevide = ActiveSheet.Columns(1).Find("").Row
Sheets("accueil").Activate
 
For i = 1 To 800
If IsNumeric(Cells(i, 1)) = True Then
 
Sheets("test").Cells(numlignevide, 1).Value = Sheets("Accueil").Cells(i, 1).Value
 
End If
Next
numlignevide = numlignevide + 1
End Sub

Pour séparer les chiffres les chiffres des colonnes j'utiliserais la méthode (donnés/convertir) et je ferai une macro grâce à l'enregistreur (j'ai testé, cette partie fonctionne

)

Pourriez vous juste m'aider pour que mon code fonctionne svp?

**patricktoulon** · 07/04/2015, 17h07

Bonjour

peut être faudrait il savoir quelle partie de la page t'intéresse et de capter que celle ci vu que la page arrive en chanbouli avec querytables

di moi quelle partie t'intéresse de cette page et je te fait un exemple

**nicdodo** · 07/04/2015, 18h34

ok, vous m'avez déjà aidé sur un problème précédent, celui ou je devais faire une double boucle et ou je ne trouvais pas le bug. En fait j'ai repris tout le code et y suis arrivé, je m'étais emmêlé les pinceaux dans les lignes

.

En gros c'est quasiment toute la feuille qui m’intéresse mais les lignes de celle ci peuvent changer selon le lien, par exemple dans la feuille 1 je suis intéressée par la partie (A214 : D476) mais pour la feuille 2 (A210 : D362).

Mon but étant de récupérer les différentes cotes j'ai d'abord chercher une méthode scientifique qu'importe les lignes donc j'ai répertorié des points de repaires

- Les deux feuilles ont des parties communes par exemple pour la feuille 1 nous avons en B230 "-0.5 4.75" et en feuille 2 en B215 "-0.5 4.60"
- Les cotes sont dans la même cellules que la description de la cote (ex:en A214 "Monaco 1.68") mais les descriptions sont en noirs et les cotes en rouges
- On peut séparer sans aide de macro deux termes d'une même cellule grâce au menu "donnés=>convertir"
- Toutes les feuilles que j'analyserai avec la macro ont la même structure et les même termes

Mon problème est pour le travail de regroupement des données, même si j'ai les points commun il me manque les compétences techniques pour arriver au résultat de la feuille 3 (Celui ci est fait manuellement, je souhaiterai pouvoir avoir exactement ça une fois la macro appliqué pour la feuille 1 ou 2. Dans mon exemple je prends à partir des données de la feuille 1)

J'ai essayé d'utiliser la méthode "isnumeric" pour dégrossir mais si j'arrive à lui dire

Code :

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

if isnumeric(cells(i,e)) = false then

je n'arrive pas à lui demander de supprimer les cellules n'ayant aucun nombres. Tout ça pour dire que j'ai vraiment essayé par moi même mais que les contraintes techniques sont trop importantes pour mes connaissances et qu'il me semble au vu de la structure des pages qu'utiliser la difference de couleur pour dissocier les termes des cellules semble la plus rigoureuse et stable des solutions.

Je vous mets le fichier exemple en pièce jointe.
Encore merci pour votre aide

**patricktoulon** · 07/04/2015, 18h52

non c'est pas ca mais c'est surtout que selon les equipes les tableaux sont aléatoirement transposé
tantot entete verticale tantot entêtes horizontale

ce qui rend l'otomatisation par ce principe caduque c'est pour ca que je t'ai demander plutôt quelle partie mais si c'est tout que tu veux ta du boulot pour tout transposé efficaement dans un tableau

je serait toi je ferait une requête; intégrerais le code html de la page dans un htmlfile en mémoire ;et avec les outils IE récupérer chaque tableaux en les disséquant 1 par 1
il y a que comme ca que tu fera un travail fiable sinon ca risque de fonctionner aujourd'hui et demain Walouh.......

t'é prêt pour l'aventure ?

il y a une chose qui cependant est riccurente
les titres des tableaux !!!!!

Résultat
Résultat double
Nombre total de buts
Score exact
Résultat à la mi-temps
Mi-temps / Fin de match
Écart de buts
Résultat final sans nul
But marqué par
Match et buts
Equipes à marquer
Résultat / But pour les 2 équipes
Équipe qui marque
Total de buts Domicile
Total de buts Extérieur
Score exact à la mi-temps
Nombre total de buts
Total de buts dom. 1ère MT
Total de buts ext. 1ère MT
MT la plus prolifique
Mi-temps
Paris Équipe
Résultat 2ème MT
Score exact 2ème MT
Total de buts dom. 2ème MT
Total de buts ext. 2ème MT
Nombre exact de buts
Équipe qui gagne sans prendre de buts
Minute du premier but (15 mn)

**nicdodo** · 07/04/2015, 19h45

Mon but est de faire un programme d'optimisation de paris sportif, j'ai deja fait une feuille de stat par équipe de ligue 1 avec des statistiques ciblées correspondantes à 5 sites de pari. Pour ce faire j'ai 5 feuilles dans mon programme avec chacune le nom d'un des sites de pari qui sont toutes au même format et dont je n'ai que les cotes à rentrer manuellement dans chacune d'entre elle. A coté j'ai une 6em feuille avec un tabelau et une formule simple en si(et()) me permet de sortir la meilleur cote et le ou les sites qui proposent cette cote. Mon petit programme est quasiment terminé mais cette entrée des données des sites de pari manuellement est assez longue c'est pourquoi j'aimerais bien arriver à automatiser tout ça. En ligne de mir je me lance dans une formation de concepteur développeur de logiciel et si aujourd'hui je fais ca sur excel en vba, le comparateur de cote de pari sportif est quelque chose que j'aimerais bien adapté à internet dans un futur à moyen terme. Je vais donc essayer de faire comme vous me conseiller mais comme vous avez compris je n'ai pas les connaissances, je n'ai que des idées et ma capacité de travail. Pourriez vous m'indiquer comment devrais je m'y prendre par étapes, dois je utiliser des outils spécifiques etc... Une petite aide ou un tuto pour m'indiquer par ou et comment je dois commencer. Vous avez l'air d'avoir votre petite idée du coup je me demandé si vous pourriez me conseiller.

Cordialement

**patricktoulon** · 07/04/2015, 20h20

Pour commencer au ba a ba commence par potasser ce tutoriel

http://qwazerty.developpez.com/tutor...-et-vba-excel/

quand tu en aura compris un minimum et j'entend par la ouvrir la page rechercher un element ,récupérer son (innertext)soit sa valeur

déjà la on pourra commencer a envisager un petit code et voir meme utiliser d'autre outils fonctionnant de la meme manière mais plus rapide

**nicdodo** · 07/04/2015, 20h32

ok je vais regarder ca mais j'aimerais aussi essayer ma petite idée à savoir s'il est possible d'effacer toutes les cellules qui n'ont pas de noir et de rouge avec une condition if par exemple du genre

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
 
Sub selection ()
 for i = 1 to 800
for e = 1 to 6
 
if cells (i, e) [n'a pas de caractères rouges ET noirs] then
cells(i, e).clearcontent
 
and if 
 
 
'Mais aussi savoir si il est possible de demander à la macro de séparer les caractère rouge et noir
Du genre'
 
if cells(i, e) [contient des caractères rouges ET noirs] then
 
'si par exemple dans la cellule A1 il y'a Monaco(noir) 1.78(rouge) alors monaco en A1 est 1.78 en A2
end sub

Si c'est juste les codes couleur je pense pouvoir récupérer ça dans le css du site. Il me faudrait juste la méthode vba en fait.

Cordialement

**patricktoulon** · 07/04/2015, 20h36

redonne moi le lien de la page celui de ta macro semble mener a une autre ce soir

les codes couleurs css sont diffèrents des codes couleurs excel vba donc walouh....

**nicdodo** · 07/04/2015, 21h14

c'est sur mais lorsque les données sont transférées sur excel deux couleur apparaissent dans les cellules il doit donc y'avoir un code couleur correspondant. Mais à la rigueur c'est pas grave il me faudrai juste l'action de, que la couleur soit bleu jaune ou magneta j'adapte apres je dois faire mon travail de recherche c'est juste que je n'ai rien trouvé que je puisse adapter ou meme qui puisse m'aider sur tous les tutos et forums que j'ai consulté depuis ce matin pour separer deux mots de deux couleurs differentes en 2 colonnes dinstintes

la page web de reference de la feuille 2 c'est celle la : https://www.betclic.fr/caen-monaco-m900516

Pour la feuille 1 le match ayant commencé elle n'existe plus

l'enregistruer de macro me dit que c'est cette couleur qui est utilisé

Color = -16777063

**patricktoulon** · 07/04/2015, 23h29

"-" c'est pas possible c'est parce que il ne reconnais pas la couleur

**nicdodo** · 08/04/2015, 00h10

Ok merci beaucoup, j'ai commencé à lire le tuto mais j'ai un problème avec ie du coup c'est un peu compliqué. J'ai néanmoins réussi à trouver une méthode un peu fastidieuse, qui nécessitera certainement une retouche du code pour l'alléger mais je vais m'y atteler et vous poster le fichier une fois terminé.

PS: vous risquez de trouver ça affreusement moche mais parfois si on peut pas prendre l'autoroute faute de moyen on peut arriver à destination par les nationales ^^

**Promethee25** · 08/04/2015, 13h41

Bonjour,

ça me semblerait plus aisé de travailler par expression régulière analysant directement le code html.
Ne peux-tu pas envoyer un extrait du code html? (le site est bloqué à mon boulot)

**nicdodo** · 08/04/2015, 15h58

Ben en fait c'est peut être plus aisé avec le code html mais étant donné que excel me transvase les info de la page que je veux je n'ai qu'a retirer les info par formules logiques en faisant une boucle. Pour l'instant ça fonctionne bien, voila le vilain code tout moche que j'ai fait, il est incomplet mais on comprend l'idée

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
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
Sub trier_site_betclic()
 
 
e = 2
d = 3
c = 4
Sheets("indexsite").Activate
 
'MENU RESULTAT MATCH'
 
'recherche victoire equipe à domicile'
 
For i = 1 To 225
 
If Cells(i, 1).Value Like ("Montpellier" & " " & "#,##") Or Cells(i, 1).Value Like ("Monaco" & " " & "#,##") Or Cells(i, 1).Value Like ("Caen" & " " & "#,##") Or Cells(i, 1).Value Like ("Paris" & " " & "#,##") Or Cells(i, 1).Value Like ("Bastia" & " " & "#,##") Or Cells(i, 1).Value Like ("Marseille" & " " & "#,##") Or Cells(i, 1).Value Like ("Reims" & " " & "#,##") Or Cells(i, 1).Value Like ("Saint-Etienne" & " " & "#,##") Or Cells(i, 1).Value Like ("Lyon" & " " & "#,##") Or Cells(i, 1).Value Like ("Nantes" & " " & "#,##") Or Cells(i, 1).Value Like ("Lens" & " " & "#,##") Or Cells(i, 1).Value Like ("Toulouse" & " " & "#,##") Or Cells(i, 1).Value Like ("Evian Thonon G" & " " & "#,##") Or Cells(i, 1).Value Like ("Lille" & " " & "#,##") Or Cells(i, 1).Value Like ("Rennes" & " " & "#,##") Or Cells(i, 1).Value Like ("Lorient" & " " & "#,##") Or Cells(i, 1).Value Like ("Nice" & " " & "#,##") Or Cells(i, 1).Value Like ("Guinguamp" & " " & "#,##") Or Cells(i, 1).Value Like ("Bordeaux" & " " & "#,##") Then
Sheets("orgadonnées").Cells(2, 18).Value = Sheets("indexsite").Cells(i, 1).Value
End If
Next
 
'recherche defaite equipe à domicile'
 
For i = 1 To 225
 
If Cells(i, d).Value Like ("Montpellier" & " " & "#,##") Or Cells(i, d).Value Like ("Monaco" & " " & "#,##") Or Cells(i, d).Value Like ("Caen" & " " & "#,##") Or Cells(i, d).Value Like ("Paris" & " " & "#,##") Or Cells(i, d).Value Like ("Bastia" & " " & "#,##") Or Cells(i, d).Value Like ("Marseille" & " " & "#,##") Or Cells(i, d).Value Like ("Reims" & " " & "#,##") Or Cells(i, d).Value Like ("Saint-Etienne" & " " & "#,##") Or Cells(i, d).Value Like ("Lyon" & " " & "#,##") Or Cells(i, d).Value Like ("Nantes" & " " & "#,##") Or Cells(i, d).Value Like ("Lens" & " " & "#,##") Or Cells(i, d).Value Like ("Toulouse" & " " & "#,##") Or Cells(i, d).Value Like ("Evian Thonon G" & " " & "#,##") Or Cells(i, d).Value Like ("Lille" & " " & "#,##") Or Cells(i, d).Value Like ("Rennes" & " " & "#,##") Or Cells(i, d).Value Like ("Lorient" & " " & "#,##") Or Cells(i, d).Value Like ("Nice" & " " & "#,##") Or Cells(i, d).Value Like ("Guinguamp" & " " & "#,##") Or Cells(i, d).Value Like ("Bordeaux" & " " & "#,##") Then
Sheets("orgadonnées").Cells(2, 19).Value = Sheets("indexsite").Cells(i, d).Value
End If
Next
 
'recherche Nul'
 
For i = 1 To 225
 
If Cells(i, e) Like ("*Nul*#,##") Then
Sheets("orgadonnées").Cells(2, 3).Value = Sheets("indexsite").Cells(i, e).Value
End If
Next
 
'separation des données du Menu resulat Match
Sheets("orgadonnées").Activate
 
    Range("N2").FormulaR1C1 = "=LEFT(RC[4],SEARCH("" "",RC[4])-1)"
    Range("O2").FormulaR1C1 = "=RIGHT(RC[3],LEN(RC[3])-SEARCH("" "",RC[3]))"
        Range("N2").Copy
    Range("A2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("O2").Copy
    Range("B2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
    Range("C2").TextToColumns Destination:=Range("C2"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(3, 1)), TrailingMinusNumbers:=True
 
    Range("P2").FormulaR1C1 = "=LEFT(RC[3],SEARCH("" "",RC[3])-1)"
    Range("Q2").FormulaR1C1 = "=RIGHT(RC[2],LEN(RC[2])-SEARCH("" "",RC[2]))"
    Range("P2").Copy
    Range("F2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("Q2").Copy
    Range("G2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
    Range("N2:S2").ClearContents
 
'MENU NOMBRE DE BUT TOTAL '
 
'A match - de x'
Sheets("indexsite").Activate
For i = 1 To 255
 
'- de 0.5but'
If Cells(i, e) Like ("*- de 0,5*#,##") Then
Sheets("orgadonnées").Cells(4, 1).Value = Sheets("indexsite").Cells(i, e).Value
End If
'- de 1.5but'
If Cells(i, e) Like ("*- de 1,5*#,##") Then
Sheets("orgadonnées").Cells(4, 3).Value = Sheets("indexsite").Cells(i, e).Value
End If
'- de 2.5but'
If Cells(i, e) Like ("*- de 2,5*#,##") Then
Sheets("orgadonnées").Cells(4, 5).Value = Sheets("indexsite").Cells(i, e).Value
End If
'- de 3.5but'
If Cells(i, e) Like ("*- de 3,5*#,##") Then
Sheets("orgadonnées").Cells(4, 7).Value = Sheets("indexsite").Cells(i, e).Value
End If
'- de 4.5but'
If Cells(i, e) Like ("*- de 4,5*#,##") Then
Sheets("orgadonnées").Cells(4, 9).Value = Sheets("indexsite").Cells(i, e).Value
End If
'- de 5.5but'
If Cells(i, e) Like ("*- de 5,5*#,##") Then
Sheets("orgadonnées").Cells(4, 11).Value = Sheets("indexsite").Cells(i, e).Value
End If
Next
 
'on enleve les espaces pour préparer la réorganisation des cellules'
 
Sheets("orgadonnées").Rows(4).Replace " ", ""
 
'separation des données du Menu resulat Match
Sheets("orgadonnées").Activate
 
    Range("A4").TextToColumns Destination:=Range("A4"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(6, 1)), TrailingMinusNumbers:=True
    Range("C4").TextToColumns Destination:=Range("C4"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(6, 1)), TrailingMinusNumbers:=True
    Range("E4").TextToColumns Destination:=Range("E4"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(6, 1)), TrailingMinusNumbers:=True
    Range("G4").TextToColumns Destination:=Range("G4"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(6, 1)), TrailingMinusNumbers:=True
    If Cells(4, 9) <> "" Then
    Range("I4").TextToColumns Destination:=Range("I4"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(6, 1)), TrailingMinusNumbers:=True
        Else: Cells(4, 9) = ""
        End If
    If Cells(4, 11) <> "" Then
    Range("K4").TextToColumns Destination:=Range("K4"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(6, 1)), TrailingMinusNumbers:=True
        Else: Cells(4, 11) = ""
        End If
'B match + de x'
Sheets("indexsite").Activate
For i = 1 To 255
 
'+ de 0.5but'
If Cells(i, e) Like ("*+ de 0,5*#,##") Then
Sheets("orgadonnées").Cells(6, 1).Value = Sheets("indexsite").Cells(i, e).Value
End If
'+ de 1.5but'
If Cells(i, e) Like ("*+ de 1,5*#,##") Then
Sheets("orgadonnées").Cells(6, 3).Value = Sheets("indexsite").Cells(i, e).Value
End If
'+ de 2.5but'
If Cells(i, e) Like ("*+ de 2,5*#,##") Then
Sheets("orgadonnées").Cells(6, 5).Value = Sheets("indexsite").Cells(i, e).Value
End If
'+ de 3.5but'
If Cells(i, e) Like ("*+ de 3,5*#,##") Then
Sheets("orgadonnées").Cells(6, 7).Value = Sheets("indexsite").Cells(i, e).Value
End If
'+ de 4.5but'
If Cells(i, e) Like ("*+ de 4,5*#,##") Then
Sheets("orgadonnées").Cells(6, 9).Value = Sheets("indexsite").Cells(i, e).Value
End If
'+ de 5.5but'
If Cells(i, e) Like ("*+ de 5,5*#,##") Then
Sheets("orgadonnées").Cells(6, 11).Value = Sheets("indexsite").Cells(i, e).Value
End If
Next
 
'on enleve les espaces pour préparer la réorganisation des cellules'
 
Sheets("orgadonnées").Rows(6).Replace " ", ""
 
'separation des données du Menu resulat Match
Sheets("orgadonnées").Activate
 
    Range("A6").TextToColumns Destination:=Range("A6"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(6, 1)), TrailingMinusNumbers:=True
    Range("C6").TextToColumns Destination:=Range("C6"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(6, 1)), TrailingMinusNumbers:=True
    Range("E6").TextToColumns Destination:=Range("E6"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(6, 1)), TrailingMinusNumbers:=True
    Range("G6").TextToColumns Destination:=Range("G6"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(6, 1)), TrailingMinusNumbers:=True
     If Cells(6, 9) <> "" Then
    Range("I6").TextToColumns Destination:=Range("I6"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(6, 1)), TrailingMinusNumbers:=True
      Else: Cells(6, 9) = ""
      End If
     If Cells(6, 11) <> "" Then
    Range("K6").TextToColumns Destination:=Range("K6"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(6, 1)), TrailingMinusNumbers:=True
      Else: Cells(6, 11) = ""
      End If
 
'MENU NOMBRE DE BUT 1ER MI TEMPS '
 
'A 1er mi temps - de x'
 
Sheets("indexsite").Activate
 
For i = 1 To 255
 
'- de 0.5but'
If Cells(i, d) Like ("*- de 0,5*#,##") Then
Sheets("orgadonnées").Cells(8, 1).Value = Sheets("indexsite").Cells(i, d).Value
End If
'- de 1.5but'
If Cells(i, d) Like ("*- de 1,5*#,##") Then
Sheets("orgadonnées").Cells(8, 3).Value = Sheets("indexsite").Cells(i, d).Value
End If
'- de 2.5but'
If Cells(i, d) Like ("*- de 2,5*#,##") Then
Sheets("orgadonnées").Cells(8, 5).Value = Sheets("indexsite").Cells(i, d).Value
End If
'- de 3.5but'
If Cells(i, d) Like ("*- de 3,5*#,##") Then
Sheets("orgadonnées").Cells(8, 7).Value = Sheets("indexsite").Cells(i, d).Value
End If
'- de 4.5but'
If Cells(i, d) Like ("*- de 4,5*#,##") Then
Sheets("orgadonnées").Cells(8, 9).Value = Sheets("indexsite").Cells(i, d).Value
End If
'- de 5.5but'
If Cells(i, d) Like ("*- de 5,5*#,##") Then
Sheets("orgadonnées").Cells(8, 11).Value = Sheets("indexsite").Cells(i, d).Value
End If
Next
 
'on enleve les espaces pour préparer la réorganisation des cellules'
 
Sheets("orgadonnées").Rows(8).Replace " ", ""
 
'separation des données du Menu resulat Match
 
Sheets("orgadonnées").Activate
 
    If Cells(8, 1) <> "" Then
    Range("A8").TextToColumns Destination:=Range("A8"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(6, 1)), TrailingMinusNumbers:=True
     Else: Cells(8, 1) = ""
        End If
 
    If Cells(8, 3) <> "" Then
    Range("C8").TextToColumns Destination:=Range("C8"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(6, 1)), TrailingMinusNumbers:=True
    Else: Cells(8, 3) = ""
        End If
 
    If Cells(8, 5) <> "" Then
    Range("E8").TextToColumns Destination:=Range("E8"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(6, 1)), TrailingMinusNumbers:=True
        Else: Cells(8, 5) = ""
        End If
 
    If Cells(8, 7) <> "" Then
    Range("G8").TextToColumns Destination:=Range("G8"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(6, 1)), TrailingMinusNumbers:=True
        Else: Cells(8, 7) = ""
        End If
 
    If Cells(8, 9) <> "" Then
    Range("I8").TextToColumns Destination:=Range("I8"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(6, 1)), TrailingMinusNumbers:=True
        Else: Cells(8, 9) = ""
 
        End If
    If Cells(8, 11) <> "" Then
    Range("K4").TextToColumns Destination:=Range("K4"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(6, 1)), TrailingMinusNumbers:=True
        Else: Cells(8, 11) = ""
        End If
 
'B 1er mi temps + de x'
 
Sheets("indexsite").Activate
 
For i = 1 To 255
 
'+ de 0.5but'
If Cells(i, d) Like ("*+ de 0,5*#,##") Then
Sheets("orgadonnées").Cells(10, 1).Value = Sheets("indexsite").Cells(i, d).Value
End If
'+ de 1.5but'
If Cells(i, d) Like ("*+ de 1,5*#,##") Then
Sheets("orgadonnées").Cells(10, 3).Value = Sheets("indexsite").Cells(i, d).Value
End If
'+ de 2.5but'
If Cells(i, d) Like ("*+ de 2,5*#,##") Then
Sheets("orgadonnées").Cells(10, 5).Value = Sheets("indexsite").Cells(i, d).Value
End If
'+ de 3.5but'
If Cells(i, d) Like ("*+ de 3,5*#,##") Then
Sheets("orgadonnées").Cells(10, 7).Value = Sheets("indexsite").Cells(i, d).Value
End If
'+ de 4.5but'
If Cells(i, d) Like ("*+ de 4,5*#,##") Then
Sheets("orgadonnées").Cells(10, 9).Value = Sheets("indexsite").Cells(i, d).Value
End If
'+ de 5.5but'
If Cells(i, d) Like ("*+ de 5,5*#,##") Then
Sheets("orgadonnées").Cells(10, 11).Value = Sheets("indexsite").Cells(i, d).Value
End If
Next
 
'on enleve les espaces pour préparer la réorganisation des cellules'
 
Sheets("orgadonnées").Rows(10).Replace " ", ""
 
'separation des données du Menu resulat Match
 
Sheets("orgadonnées").Activate
    If Cells(10, 1) <> "" Then
    Range("A10").TextToColumns Destination:=Range("A10"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(6, 1)), TrailingMinusNumbers:=True
     Else: Cells(10, 1) = ""
        End If
 
    If Cells(10, 3) <> "" Then
    Range("C10").TextToColumns Destination:=Range("C10"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(6, 1)), TrailingMinusNumbers:=True
    Else: Cells(10, 3) = ""
        End If
 
    If Cells(10, 5) <> "" Then
    Range("E10").TextToColumns Destination:=Range("E10"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(6, 1)), TrailingMinusNumbers:=True
        Else: Cells(10, 5) = ""
        End If
 
    If Cells(10, 7) <> "" Then
    Range("G10").TextToColumns Destination:=Range("G10"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(6, 1)), TrailingMinusNumbers:=True
        Else: Cells(10, 7) = ""
        End If
 
    If Cells(10, 9) <> "" Then
    Range("I10").TextToColumns Destination:=Range("I10"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(6, 1)), TrailingMinusNumbers:=True
        Else: Cells(10, 9) = ""
        End If
 
    If Cells(10, 11) <> "" Then
    Range("K10").TextToColumns Destination:=Range("K10"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(6, 1)), TrailingMinusNumbers:=True
        Else: Cells(10, 11) = ""
        End If
 
'MENU NOMBRE DE BUT 2ND MI TEMPS '
 
'A 2nd mi temps - de x'
 
Sheets("indexsite").Activate
 
For i = 1 To 255
 
'- de 0.5but'
If Cells(i, c) Like ("*- de 0,5*#,##") Then
Sheets("orgadonnées").Cells(12, 1).Value = Sheets("indexsite").Cells(i, c).Value
End If
'- de 1.5but'
If Cells(i, c) Like ("*- de 1,5*#,##") Then
Sheets("orgadonnées").Cells(12, 3).Value = Sheets("indexsite").Cells(i, c).Value
End If
'- de 2.5but'
If Cells(i, c) Like ("*- de 2,5*#,##") Then
Sheets("orgadonnées").Cells(12, 5).Value = Sheets("indexsite").Cells(i, c).Value
End If
'- de 3.5but'
If Cells(i, c) Like ("*- de 3,5*#,##") Then
Sheets("orgadonnées").Cells(12, 7).Value = Sheets("indexsite").Cells(i, c).Value
End If
'- de 4.5but'
If Cells(i, c) Like ("*- de 4,5*#,##") Then
Sheets("orgadonnées").Cells(12, 9).Value = Sheets("indexsite").Cells(i, c).Value
End If
'- de 5.5but'
If Cells(i, c) Like ("*- de 5,5*#,##") Then
Sheets("orgadonnées").Cells(12, 11).Value = Sheets("indexsite").Cells(i, c).Value
End If
Next
 
'on enleve les espaces pour préparer la réorganisation des cellules'
 
Sheets("orgadonnées").Rows(12).Replace " ", ""
 
'separation des données du Menu resulat Match
 
Sheets("orgadonnées").Activate
 
    If Cells(12, 1) <> "" Then
    Range("A12").TextToColumns Destination:=Range("A12"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(6, 1)), TrailingMinusNumbers:=True
     Else: Cells(12, 1) = ""
        End If
 
    If Cells(12, 3) <> "" Then
    Range("C12").TextToColumns Destination:=Range("C12"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(6, 1)), TrailingMinusNumbers:=True
    Else: Cells(12, 3) = ""
        End If
 
    If Cells(12, 5) <> "" Then
    Range("E12").TextToColumns Destination:=Range("E12"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(6, 1)), TrailingMinusNumbers:=True
        Else: Cells(12, 5) = ""
        End If
 
    If Cells(12, 7) <> "" Then
    Range("G12").TextToColumns Destination:=Range("G12"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(6, 1)), TrailingMinusNumbers:=True
        Else: Cells(12, 7) = ""
        End If
 
    If Cells(12, 9) <> "" Then
    Range("I8").TextToColumns Destination:=Range("I12"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(6, 1)), TrailingMinusNumbers:=True
        Else: Cells(12, 9) = ""
 
        End If
    If Cells(12, 11) <> "" Then
    Range("K4").TextToColumns Destination:=Range("K12"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(6, 1)), TrailingMinusNumbers:=True
        Else: Cells(12, 11) = ""
        End If
 
'B 2nd mi temps + de x'
 
Sheets("indexsite").Activate
 
For i = 1 To 255
 
'+ de 0.5but'
If Cells(i, c) Like ("*+ de 0,5*#,##") Then
Sheets("orgadonnées").Cells(14, 1).Value = Sheets("indexsite").Cells(i, c).Value
End If
'+ de 1.5but'
If Cells(i, c) Like ("*+ de 1,5*#,##") Then
Sheets("orgadonnées").Cells(14, 3).Value = Sheets("indexsite").Cells(i, c).Value
End If
'+ de 2.5but'
If Cells(i, c) Like ("*+ de 2,5*#,##") Then
Sheets("orgadonnées").Cells(14, 5).Value = Sheets("indexsite").Cells(i, c).Value
End If
'+ de 3.5but'
If Cells(i, c) Like ("*+ de 3,5*#,##") Then
Sheets("orgadonnées").Cells(14, 7).Value = Sheets("indexsite").Cells(i, c).Value
End If
'+ de 4.5but'
If Cells(i, c) Like ("*+ de 4,5*#,##") Then
Sheets("orgadonnées").Cells(14, 9).Value = Sheets("indexsite").Cells(i, c).Value
End If
'+ de 5.5but'
If Cells(i, c) Like ("*+ de 5,5*#,##") Then
Sheets("orgadonnées").Cells(14, 11).Value = Sheets("indexsite").Cells(i, c).Value
End If
Next
 
'on enleve les espaces pour préparer la réorganisation des cellules'
 
Sheets("orgadonnées").Rows(14).Replace " ", ""
 
'separation des données du Menu resulat Match
 
Sheets("orgadonnées").Activate
    If Cells(14, 1) <> "" Then
    Range("A14").TextToColumns Destination:=Range("A14"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(6, 1)), TrailingMinusNumbers:=True
     Else: Cells(14, 1) = ""
        End If
 
    If Cells(14, 3) <> "" Then
    Range("C14").TextToColumns Destination:=Range("C14"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(6, 1)), TrailingMinusNumbers:=True
    Else: Cells(14, 3) = ""
        End If
 
    If Cells(14, 5) <> "" Then
    Range("E14").TextToColumns Destination:=Range("E14"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(6, 1)), TrailingMinusNumbers:=True
        Else: Cells(14, 5) = ""
        End If
 
    If Cells(14, 7) <> "" Then
    Range("G14").TextToColumns Destination:=Range("G14"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(6, 1)), TrailingMinusNumbers:=True
        Else: Cells(14, 7) = ""
        End If
 
    If Cells(14, 9) <> "" Then
    Range("I14").TextToColumns Destination:=Range("I14"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(6, 1)), TrailingMinusNumbers:=True
        Else: Cells(14, 9) = ""
        End If
 
    If Cells(14, 11) <> "" Then
    Range("K14").TextToColumns Destination:=Range("K14"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(6, 1)), TrailingMinusNumbers:=True
        Else: Cells(14, 11) = ""
 
        End If
 
end sub

**patricktoulon** · 08/04/2015, 19h39

LOL on frôle le message d'erreur "procedure trop longue"

**Pierre Fauconnier** · 08/04/2015, 21h08

Salut.

Je ne peux qu'être d'accord avec Prométhée... surtout au vu d'une procédure de 284 lignes...

**nicdodo** · 08/04/2015, 21h15

Héhé oui oui, les nationales sont parfois longues. Non mais je vais faire comme vous me conseillez il faut juste que j'apprenne à faire. La c'est juste que je fais mes petits test et du coup ça m'a appris plein de truc notamment, la formule link et scindé une colonne en deux avec l'outils données. J'en ai pas vraiment besoin mais ca me permet d'apprendre sur le tas sans que ça soit trop scolaire. Ça m'apprend la logique du langage info avant de rentrer en formation pour devenir concepteur développeur et pour le coup la ça sera très scolaire

E tout cas merci pour votre aide sincerement

Isoler deux termes d'une même cellule

Macros et VBA Excel

Discussions similaires

Partager

Partager