Taille du fichier en exponentiel suite requete puis optimisation

**patricktoulon** · 27/07/2015, 18h05

non de dieu!!

enregistre ton fichier et ferme le :inspire

ouvre un nouveau fichier
met ca dans un module

il y a 2 exemple de ligne (ton model et le mien ) qui ont quelques petites différence ca on le sais

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub test()
 
'model seb
'textedebut = "QUINTE Arrivée du QUINTE PMU d'hier Dimanche 26 Juillet 2015: 1-7-10-2-4 27/07/2015 [Il est 13:35:09] - Course 4590 PRONOSTICS PRESSE HIPPIQUE POUR LE QUINTE PMU: Prix DU SILENCE (PRIX MISS DAN) - 16 partants à CLAIREFONTAINE Lundi le 27 - 07 - 2015, Réunion 1 Course 2 Départ: 13h50 (allocation: 60000€) Plat PRONOSTICS DE LA PRESSE (Revue de Presse) de pronostics-turf.info "
 
'model pat
    textedebut = "QUINTE Arrivée du QUINTE PMU d'aujourd'hui Lundi 27 Juillet 2015: 14-5-9/11-7 27/07/2015 [Il est 17:42:03]-Course 4590 QUINTE: Prix DU BOIS BRANDIN à CHANTILLY Mardi le 28-07-2015, Réunion 1 Course 3 Départ: 13h50 (allocation: 60000€) Plat PRONOSTICS DE LA PRESSE (Revue de Presse) de pronostics-turf.info"
    nomprix = "Prix" & Split(Split(textedebut, "Prix")(1), "à")(0)
    If InStr(nomprix, "partants") > 0 Then
        nomprix = Split(nomprix, " -")(0)
        nbpartant = Replace(Split(Split(textedebut, " partants")(0), nomprix)(1), "-", "")
    End If
    MsgBox nomprix & vbCrLf & nbpartant
End Sub

teste 1 fois en metant ton model en comentaire
tu aura le prix mais pas les partants c'est normal je ne les ai jamais
teste une 2 eme fois en mettant mon model en commentaire et en débloquant le tien
tu aura le prix et les partants

POINT BARRE!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

yen a assez

**Sebphyto** · 27/07/2015, 18h22

Ok ca me va
Nom : Capture.PNG
Affichages : 996
Taille : 19,9 Ko

Nom : Capture2.PNG
Affichages : 736
Taille : 19,5 Ko

Alors pourquoi ca ne fonctionne pas dans le code 59

car si je découpe comme tout à l'heure

Code :

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

1
2
3
4
5
6
7
8
9
10
11
prix = "Prix " & Split(Split(textedebut, "Prix")(1), "à")(0)
    If InStr(prix, "partants") > 0 Then
        prix = Split(prix, "-")(0)
 
 
        nb = Split(textedebut, " partants")
        nb2 = Split(nb(0), " - ")
        nbpart = nb2(5)
 
 
    End If

Ca fonctionne

et si je decoupe en mettant prix a la place de " - "

Code :

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

1
2
3
4
5
6
7
8
9
10
nomprix = "Prix " & Split(Split(textedebut, "Prix")(1), "à")(0)
    If InStr(nomprix, "partants") > 0 Then
        nomprix = Split(nomprix, "-")(0)
 
 
        nb = Split(textedebut, " partants")
        nb2 = Split(nb(0), prix)
        nbpart = nb2(5)
 
    End If

ce qui revient à dire que je fais comme ton code

Code :

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

nbpartant = Split(Split(textedebut, " partants")(0), nomprix)(1)

ca ne fonctionne pas

mais on n'a pas le même textedebut, d'où l'erreur j'imagine

**patricktoulon** · 27/07/2015, 18h29

mais on n'a pas le même textedebut, d'où l'erreur j'imagine

on s'en balance

le code est fait pour fonctionner sur les deux le teste que je t'ai donné le prouve
si tu a encore un bug ca veut dire que ta ligne a encore changer
prends cette ligne maintenant et envoie la

j'ai corrigé l'arrivé c'est bon :encore une fois avec les deux models ca fonctionne
prend celui la

pour la dsp je suis en train de voir

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
Sub testesimple59()
    Dim z As Long, pluss As Long, dicoseb, dicopat, mesTRREF, listPRnst, MESTH, docTemp
    listPRnst = Array("Bilto :", "Agence TIP :", "Top Entraineurs : ", "Stato Turf : ", "Paris Turf : ")
    Set dicoseb = CreateObject("Scripting.Dictionary")
    Set dicopat = CreateObject("Scripting.Dictionary")
    Set docTemp = CreateObject("htmlfile")
    URL = "http://www.pronostics-turf.info/fg-pronostics-presse.php"
    Set IE = CreateObject("internetexplorer.application")
    With IE:
        .navigate URL
        'IE.Visible = True:
        Do: DoEvents: Loop While .readystate <> 4 Or .busy
        codehtml = .document.body.innerhtml
        'on crée une table avec les source choisie
        Set mesTR = .document.getelementsbytagname("tr")
        For i = 0 To mesTR.Length - 1
            For p = 0 To UBound(listPRnst)
                If InStr(mesTR(i).innertext, listPRnst(p)) > 0 Then codetable = codetable & mesTR(i).outerhtml
            Next
        Next
        codetable = "<table ID=tableref>" & codetable & "</table>"
        'on créé une table avec la synthese
        ligneplace = "<TR bgcolor=""#BDBDBD"" id=Places><TH>Places</TH>"
        lignecheval = "<TR bgcolor=""#BDBDBD"" id=cheval><TH>Cheval</TH>"
        For i = 1 To 17
            ligneplace = ligneplace & "<TH>" & i & "</TH>"
            lignecheval = lignecheval & "<TH>" & i & "</TH>"
        Next
        ligneplace = ligneplace & "</TR>"
        lignecheval = lignecheval & "</TR>"
        For i = 0 To mesTR.Length - 1
            If InStr(mesTR(i).innertext, "Synthèse") > 0 Then
                For Each elem In mesTR(i).Children: elem.innerhtml = elem.innertext: Next
                mesTR(i).ID = "synthW"
                codesynth = ligneplace & mesTR(i).outerhtml & "<TR></TR>" & lignecheval
            End If
        Next
        'on prepare la lignes des syntheses pat et seb
        suitesynth = suitesynth & "<tr id=fois><th> X fois cité</th>" & Application.Rept("<th>0</th>", 17) & vbCrLf
        suitesynth = suitesynth & "<tr id=synthS><th> synthese sebphyto</th>" & Application.Rept("<th></th>", 17) & vbCrLf
        suitesynth = suitesynth & "<tr id=synthP><th> synthese patrick</th>" & Application.Rept("<th></th>", 17) & vbCrLf
        codesynth = "<table>" & codesynth & suitesynth & "</table>"
        'on supprime le script 3 et on récupère le debut
        lscript = Split(codehtml, "<script")
        codehtml = Replace(codehtml, Split(lscript(3), "</script>")(0) & "</script>", "")
        docTemp.body.innerhtml = codehtml
        DEBUT = Split(Split(docTemp.body.innerhtml, "Résultat")(1), "<TABLE")(0)
        docTemp.body.innerhtml = DEBUT
        textedebut = "": textedebut = Replace(docTemp.body.innertext, " - ", "-") & "     "
        Set docTemp = Nothing
        .Quit
    End With
    'model seb
   'textedebut = "QUINTE Arrivée du QUINTE PMU d'hier Dimanche 26 Juillet 2015: 1-7-10-2-4 27/07/2015 [Il est 13:35:09] - Course 4590 PRONOSTICS PRESSE HIPPIQUE POUR LE QUINTE PMU: Prix DU SILENCE (PRIX MISS DAN) - 16 partants à CLAIREFONTAINE Lundi le 27 - 07 - 2015, Réunion 1 Course 2 Départ: 13h50 (allocation: 60000€) Plat PRONOSTICS DE LA PRESSE (Revue de Presse) de pronostics-turf.info "
    'model pat
    'textedebut =QUINTE Arrivée du QUINTE PMU d'aujourd'hui Lundi 27 Juillet 2015: 14-5-9/11-7 27/07/2015 [Il est 17:42:03]-Course 4590 QUINTE: Prix DU BOIS BRANDIN à CHANTILLY Mardi le 28-07-2015, Réunion 1 Course 3 Départ: 13h50 (allocation: 60000€) Plat PRONOSTICS DE LA PRESSE (Revue de Presse) de pronostics-turf.info
    ' date de la precedente course
    oldate = Split(Split(Replace(textedebut, "hui", "hier"), "hier ")(1), ":")(0)
    daystring = Split(oldate, " ")(0)
    oldate = Format(Split(oldate, daystring)(1), "dd/mm/yyyy")
    newdate = Format(Split(Split(textedebut, " le ")(1), ",")(0), "dd/mm/yyyy")
    oldarrivée = Split(Split(textedebut, ": ")(1), " ")(0)
 
    nomprix = "Prix" & Split(Split(textedebut, "Prix")(1), "à")(0)
    If InStr(nomprix, "partants") > 0 Then
        nomprix = Split(nomprix, " -")(0)
        nbpartant = Replace(Split(Split(textedebut, " partants")(0), nomprix)(1), "-", "")
    End If
    HiPPo = Split(Split(textedebut, "à ")(1), " ")(0)
    RC = "R" & Replace(Split(Split(textedebut, "Réunion ")(1), " Départ")(0), " Course ", "C")
    DsP = Split(Split(textedebut, "€) ")(1), " ")(1)
    codedebut = codedebut & "<a>" & " date de la course precedente : " & oldate & "</a><br>"
    codedebut = codedebut & "<a>" & " arrivée de la course precedente : " & oldarrivée & "</a><br>"
    codedebut = codedebut & "<a>" & " date de la nouvelle course : " & newdate & "</a><br>"
    codedebut = codedebut & "<a>" & " Hippodrome  de la nouvelle course : " & HiPPo & "</a><br>"
    codedebut = codedebut & "<a>" & " prix de la nouvelle course : " & nomprix & "</a><br>"
    codedebut = codedebut & "<a>" & " Réunion et course de la nouvelle course : " & RC & "</a><br>"
    codedebut = codedebut & "<a>" & " discipline  de la nouvelle course : " & DsP & "</a><br>"
    codedebut = codedebut & "<a>" & " nombre de partant  de la nouvelle course : " & nbpartant & "</a><br>"
 
 
    With CreateObject("htmlfile")
        .body.innerhtml = textedebut & "<br>" & codedebut & codetable & "<br>" & codesynth
 
        '************************************************************************************
        'nombre de fois cité dans les sources choisies
        Set mesthref = .getelementbyID("tableref").getelementsbytagname("TH")
        Set fois = .getelementbyID("fois")
        For i = 1 To 17
            For a = 0 To mesthref.Length - 1
                If Val(mesthref(a).innertext) = i Then fois.Children(i).innertext = Val(fois.Children(i).innertext) + 1
            Next
        Next
        '***************************************************************************
 
        If .parentWindow.clipboardData.setData("Text", .body.innerhtml) Then
            Application.ScreenUpdating = False
            With Sheets(1)
                .Activate
                .Cells.Clear
                .Columns("A:A").ColumnWidth = 15
                .Columns("B:R").ColumnWidth = 6
                Cells(2, 1).Select
                .Paste
            End With
            .parentWindow.clipboardData.clearData "Text"
        End If
    End With
End Sub

capture
si ca va pas, ne cherche pas, laisse moi faire

**Sebphyto** · 27/07/2015, 18h48

textdebut:

QUINTE Arrivée du QUINTE PMU d'aujourd'hui Lundi 27 Juillet 2015: 14-5-9/11-7 27/07/2015 [Il est 18:46:41]-Course 4590 PRONOSTICS PRESSE HIPPIQUE POUR LE QUINTE PMU: Prix DU BOIS BRANDIN-16 partants à CHANTILLY Mardi le 28-07-2015, Réunion 1 Course 3 Départ: 13h50 (allocation: 60000€) Plat PRONOSTICS DE LA PRESSE (Revue de Presse) de pronostics-turf.info

Nom : Capture.PNG
Affichages : 708
Taille : 29,8 Ko

voila

**patricktoulon** · 27/07/2015, 19h00

tiens
pareil tu touche rien tu lance la sub c'est tout normalement tout est corrigé

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
Sub testesimple59()
    Dim z As Long, pluss As Long, dicoseb, dicopat, mesTRREF, listPRnst, MESTH, docTemp
    listPRnst = Array("Bilto :", "Agence TIP :", "Top Entraineurs : ", "Stato Turf : ", "Paris Turf : ")
    Set dicoseb = CreateObject("Scripting.Dictionary")
    Set dicopat = CreateObject("Scripting.Dictionary")
    Set docTemp = CreateObject("htmlfile")
    URL = "http://www.pronostics-turf.info/fg-pronostics-presse.php"
    Set IE = CreateObject("internetexplorer.application")
    With IE:
        .navigate URL
        'IE.Visible = True:
        Do: DoEvents: Loop While .readystate <> 4 Or .busy
        codehtml = .document.body.innerhtml
        'on crée une table avec les source choisie
        Set mesTR = .document.getelementsbytagname("tr")
        For i = 0 To mesTR.Length - 1
            For p = 0 To UBound(listPRnst)
                If InStr(mesTR(i).innertext, listPRnst(p)) > 0 Then codetable = codetable & mesTR(i).outerhtml
            Next
        Next
        codetable = "<table ID=tableref>" & codetable & "</table>"
        'on créé une table avec la synthese
        ligneplace = "<TR bgcolor=""#BDBDBD"" id=Places><TH>Places</TH>"
        lignecheval = "<TR bgcolor=""#BDBDBD"" id=cheval><TH>Cheval</TH>"
        For i = 1 To 17
            ligneplace = ligneplace & "<TH>" & i & "</TH>"
            lignecheval = lignecheval & "<TH>" & i & "</TH>"
        Next
        ligneplace = ligneplace & "</TR>"
        lignecheval = lignecheval & "</TR>"
        For i = 0 To mesTR.Length - 1
            If InStr(mesTR(i).innertext, "Synthèse") > 0 Then
                For Each elem In mesTR(i).Children: elem.innerhtml = elem.innertext: Next
                mesTR(i).ID = "synthW"
                codesynth = ligneplace & mesTR(i).outerhtml & "<TR></TR>" & lignecheval
            End If
        Next
        'on prepare la lignes des syntheses pat et seb
        suitesynth = suitesynth & "<tr id=fois><th> X fois cité</th>" & Application.Rept("<th>0</th>", 17) & vbCrLf
        suitesynth = suitesynth & "<tr id=synthS><th> synthese sebphyto</th>" & Application.Rept("<th></th>", 17) & vbCrLf
        suitesynth = suitesynth & "<tr id=synthP><th> synthese patrick</th>" & Application.Rept("<th></th>", 17) & vbCrLf
        codesynth = "<table>" & codesynth & suitesynth & "</table>"
        'on supprime le script 3 et on récupère le debut
        lscript = Split(codehtml, "<script")
        codehtml = Replace(codehtml, Split(lscript(3), "</script>")(0) & "</script>", "")
        docTemp.body.innerhtml = codehtml
        DEBUT = Split(Split(docTemp.body.innerhtml, "Résultat")(1), "<TABLE")(0)
        docTemp.body.innerhtml = DEBUT
        textedebut = "": textedebut = Replace(Replace(docTemp.body.innertext, " - ", "-"), vbCrLf, " ")
        Set docTemp = Nothing
        .Quit
    End With
    'model seb
   'textedebut = "QUINTE Arrivée du QUINTE PMU d'aujourd'hui Lundi 27 Juillet 2015: 14-5-9/11-7 27/07/2015 [Il est 18:46:41]-Course 4590 PRONOSTICS PRESSE HIPPIQUE POUR LE QUINTE PMU: Prix DU BOIS BRANDIN-16 partants à CHANTILLY Mardi le 28-07-2015, Réunion 1 Course 3 Départ: 13h50 (allocation: 60000€) Plat PRONOSTICS DE LA PRESSE (Revue de Presse) de pronostics-turf.info "
    'model pat
    'textedebut =QUINTE Arrivée du QUINTE PMU d'aujourd'hui Lundi 27 Juillet 2015: 14-5-9/11-7 27/07/2015 [Il est 17:42:03]-Course 4590 QUINTE: Prix DU BOIS BRANDIN à CHANTILLY Mardi le 28-07-2015, Réunion 1 Course 3 Départ: 13h50 (allocation: 60000€) Plat PRONOSTICS DE LA PRESSE (Revue de Presse) de pronostics-turf.info
    ' date de la precedente course
    oldate = Split(Split(Replace(textedebut, "hui", "hier"), "hier ")(1), ":")(0)
    daystring = Split(oldate, " ")(0)
    oldate = Format(Split(oldate, daystring)(1), "dd/mm/yyyy")
    newdate = Format(Split(Split(textedebut, " le ")(1), ",")(0), "dd/mm/yyyy")
    oldarrivée = Split(Split(textedebut, ": ")(1), " ")(0)
 
    nomprix = "Prix" & Split(Split(textedebut, "Prix")(1), "à")(0)
    If InStr(nomprix, "partants") > 0 Then
        nomprix = Split(nomprix, "-")(0)
        nbpartant = Replace(Split(Split(textedebut, "partants")(0), nomprix)(1), "-", "")
    End If
    HiPPo = Split(Split(textedebut, "à ")(1), " ")(0)
    RC = "R" & Replace(Split(Split(textedebut, "Réunion ")(1), " Départ")(0), " Course ", "C")
    DsP = Split(Split(textedebut, "€) ")(1), " PRONOSTICS")(0)
    codedebut = codedebut & "<a>" & " date de la course precedente : " & oldate & "</a><br>"
    codedebut = codedebut & "<a>" & " arrivée de la course precedente : " & oldarrivée & "</a><br>"
    codedebut = codedebut & "<a>" & " date de la nouvelle course : " & newdate & "</a><br>"
    codedebut = codedebut & "<a>" & " Hippodrome  de la nouvelle course : " & HiPPo & "</a><br>"
    codedebut = codedebut & "<a>" & " prix de la nouvelle course : " & nomprix & "</a><br>"
    codedebut = codedebut & "<a>" & " Réunion et course de la nouvelle course : " & RC & "</a><br>"
    codedebut = codedebut & "<a>" & " discipline  de la nouvelle course : " & DsP & "</a><br>"
    codedebut = codedebut & "<a>" & " nombre de partant  de la nouvelle course : " & nbpartant & "</a><br>"
 
 
    With CreateObject("htmlfile")
        .body.innerhtml = textedebut & "<br>" & codedebut & codetable & "<br>" & codesynth
 
        '************************************************************************************
        'nombre de fois cité dans les sources choisies
        Set mesthref = .getelementbyID("tableref").getelementsbytagname("TH")
        Set fois = .getelementbyID("fois")
        For i = 1 To 17
            For a = 0 To mesthref.Length - 1
                If Val(mesthref(a).innertext) = i Then fois.Children(i).innertext = Val(fois.Children(i).innertext) + 1
            Next
        Next
        '***************************************************************************
 
        If .parentWindow.clipboardData.setData("Text", .body.innerhtml) Then
            Application.ScreenUpdating = False
            With Sheets(1)
                .Activate
                .Cells.Clear
                .Columns("A:A").ColumnWidth = 15
                .Columns("B:R").ColumnWidth = 6
                Cells(2, 1).Select
                .Paste
            End With
            .parentWindow.clipboardData.clearData "Text"
        End If
    End With
End Sub

**Sebphyto** · 27/07/2015, 19h06

C'est bon, j'ai rien touché

Nom : Capture.PNG
Affichages : 742
Taille : 35,7 Ko

**patricktoulon** · 27/07/2015, 19h18

bon avec le 59 on a maintenant le meme résultat mis a part les partants chez moi que je ne peut pas avoir

bon ben on a avancé quand meme aujourd'hui hein!!!

il faudra penser toutes fois pour le transfert dans la BDD a metre 6 case au lieu de 5 pour l'arrivée quand on a une photo ou un litige comme aujourd'hui la BDD en a que 5 donc a ne pas oublier

c'est bon on continu ou tu en a marre

**Sebphyto** · 27/07/2015, 19h25

Allez on n'y va j'en redemande......

il faudra penser toutes fois pour le transfert dans la BDD a metre 6 case au lieu de 5 pour l'arrivée quand on a une photo ou un litige comme aujourd'hui la BDD en a que 5 donc a ne pas oublier

Exact, bien joué d'y avoir pensé

a ne pas oubier également "l'indice de confiance" avoir si on le fait sur geny (on a déjà le code) ou recréer un code
ainsi que la récup rapport sur zeturf, mais ça on à déjà travailler dessus
Seb

**patricktoulon** · 27/07/2015, 19h31

ne t'emballe pas avancons proprement
voila la 60
synthese patrick

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
Sub testesimple60()
    Dim z As Long, pluss As Long, dicoseb, dicopat, mesTRREF, listPRnst, MESTH, docTemp
    listPRnst = Array("Bilto :", "Agence TIP :", "Top Entraineurs : ", "Stato Turf : ", "Paris Turf : ")
    Set dicoseb = CreateObject("Scripting.Dictionary")
    Set dicopat = CreateObject("Scripting.Dictionary")
    Set docTemp = CreateObject("htmlfile")
    URL = "<a href="http://www.pronostics-turf.info/fg-pronostics-presse.php" target="_blank">http://www.pronostics-turf.info/fg-p...ics-presse.php</a>"
    Set IE = CreateObject("internetexplorer.application")
    With IE:
        .navigate URL
        'IE.Visible = True:
        Do: DoEvents: Loop While .readystate <> 4 Or .busy
        codehtml = .document.body.innerhtml
        'on crée une table avec les source choisie
        Set mesTR = .document.getelementsbytagname("tr")
        For i = 0 To mesTR.Length - 1
            For p = 0 To UBound(listPRnst)
                If InStr(mesTR(i).innertext, listPRnst(p)) > 0 Then codetable = codetable & mesTR(i).outerhtml
            Next
        Next
        codetable = "<table ID=tableref>" & codetable & "</table>"
        'on créé une table avec la synthese
        ligneplace = "<TR bgcolor=""#BDBDBD"" id=Places><TH>Places</TH>"
        lignecheval = "<TR bgcolor=""#BDBDBD"" id=cheval><TH>Cheval</TH>"
        For i = 1 To 17
            ligneplace = ligneplace & "<TH>" & i & "</TH>"
            lignecheval = lignecheval & "<TH>" & i & "</TH>"
        Next
        ligneplace = ligneplace & "</TR>"
        lignecheval = lignecheval & "</TR>"
        For i = 0 To mesTR.Length - 1
            If InStr(mesTR(i).innertext, "Synthèse") > 0 Then
                For Each elem In mesTR(i).Children: elem.innerhtml = elem.innertext: Next
                mesTR(i).ID = "synthW"
                codesynth = ligneplace & mesTR(i).outerhtml & "<TR></TR>" & lignecheval
            End If
        Next
        'on prepare la lignes des syntheses pat et seb
        suitesynth = suitesynth & "<tr id=fois><th> X fois cité</th>" & Application.Rept("<th>0</th>", 17) & vbCrLf
        suitesynth = suitesynth & "<tr id=synthS><th> synthese sebphyto</th>" & Application.Rept("<th></th>", 17) & vbCrLf
        suitesynth = suitesynth & "<tr id=synthP><th> synthese patrick</th>" & Application.Rept("<th></th>", 17) & vbCrLf
        codesynth = "<table>" & codesynth & suitesynth & "</table>"
        'on supprime le script 3 et on récupère le debut
        lscript = Split(codehtml, "<script")
        codehtml = Replace(codehtml, Split(lscript(3), "</script>")(0) & "</script>", "")
        docTemp.body.innerhtml = codehtml
        DEBUT = Split(Split(docTemp.body.innerhtml, "Résultat")(1), "<TABLE")(0)
        docTemp.body.innerhtml = DEBUT
        textedebut = "": textedebut = Replace(Replace(docTemp.body.innertext, " - ", "-"), vbCrLf, " ")
        Set docTemp = Nothing
        .Quit
    End With
    'model seb
   'textedebut = "QUINTE Arrivée du QUINTE PMU d'aujourd'hui Lundi 27 Juillet 2015: 14-5-9/11-7 27/07/2015 [Il est 18:46:41]-Course 4590 PRONOSTICS PRESSE HIPPIQUE POUR LE QUINTE PMU: Prix DU BOIS BRANDIN-16 partants à CHANTILLY Mardi le 28-07-2015, Réunion 1 Course 3 Départ: 13h50 (allocation: 60000€) Plat PRONOSTICS DE LA PRESSE (Revue de Presse) de pronostics-turf.info "
    'model pat
    'textedebut =QUINTE Arrivée du QUINTE PMU d'aujourd'hui Lundi 27 Juillet 2015: 14-5-9/11-7 27/07/2015 [Il est 17:42:03]-Course 4590 QUINTE: Prix DU BOIS BRANDIN à CHANTILLY Mardi le 28-07-2015, Réunion 1 Course 3 Départ: 13h50 (allocation: 60000€) Plat PRONOSTICS DE LA PRESSE (Revue de Presse) de pronostics-turf.info
    ' date de la precedente course
    oldate = Split(Split(Replace(textedebut, "hui", "hier"), "hier ")(1), ":")(0)
    daystring = Split(oldate, " ")(0)
    oldate = Format(Split(oldate, daystring)(1), "dd/mm/yyyy")
    newdate = Format(Split(Split(textedebut, " le ")(1), ",")(0), "dd/mm/yyyy")
    oldarrivée = Replace(Split(Split(textedebut, ": ")(1), " ")(0), "/", "-")
 
    nomprix = "Prix" & Split(Split(textedebut, "Prix")(1), "à")(0)
    If InStr(nomprix, "partants") > 0 Then
        nomprix = Split(nomprix, "-")(0)
        nbpartant = Replace(Split(Split(textedebut, "partants")(0), nomprix)(1), "-", "")
    End If
    HiPPo = Split(Split(textedebut, "à ")(1), " ")(0)
    RC = "R" & Replace(Split(Split(textedebut, "Réunion ")(1), " Départ")(0), " Course ", "C")
    DsP = Split(Split(textedebut, "€) ")(1), " PRONOSTICS")(0)
    codedebut = codedebut & "<a>" & " date de la course precedente : " & oldate & "</a><br>"
    codedebut = codedebut & "<a>" & " arrivée de la course precedente : " & oldarrivée & "</a><br>"
    codedebut = codedebut & "<a>" & " date de la nouvelle course : " & newdate & "</a><br>"
    codedebut = codedebut & "<a>" & " Hippodrome  de la nouvelle course : " & HiPPo & "</a><br>"
    codedebut = codedebut & "<a>" & " prix de la nouvelle course : " & nomprix & "</a><br>"
    codedebut = codedebut & "<a>" & " Réunion et course de la nouvelle course : " & RC & "</a><br>"
    codedebut = codedebut & "<a>" & " discipline  de la nouvelle course : " & DsP & "</a><br>"
    codedebut = codedebut & "<a>" & " nombre de partant  de la nouvelle course : " & nbpartant & "</a><br>"
 
 
    With CreateObject("htmlfile")
        .body.innerhtml = textedebut & "<br>" & codedebut & codetable & "<br>" & codesynth
 
        '************************************************************************************
        'nombre de fois cité dans les sources choisies
        Set mesthref = .getelementbyID("tableref").getelementsbytagname("TH")
        Set fois = .getelementbyID("fois")
        For i = 1 To 17
            For a = 0 To mesthref.Length - 1
                If Val(mesthref(a).innertext) = i Then fois.Children(i).innertext = Val(fois.Children(i).innertext) + 1
            Next
        Next
        '***************************************************************************
 'syntheze patric avec  les sources choisies par points
        Set mesTRREF = .getelementbyID("tableref").getelementsbytagname("TR")
        Set synthP = .getelementbyID("synthP")
        For i = 0 To mesTRREF.Length - 1
            For z = 1 To mesTRREF(i).Children.Length - 1
                dicopat(mesTRREF(i).Children(z).innertext) = dicopat(mesTRREF(i).Children(z).innertext) + (8 - (z - 1))
            Next
        Next
        Do
            num = num + 1: old = 0
            For Each elem In dicopat
                If dicopat(elem) > old Then old = dicopat(elem): items = elem
            Next
            'MsgBox items & " :  " & dicopat(items)
            dicopat(items) = 0
            synthP.Children(num).innertext = items
        Loop Until num = dicopat.Count
        '****************************************************************************
        If .parentWindow.clipboardData.setData("Text", .body.innerhtml) Then
            Application.ScreenUpdating = False
            With Sheets(1)
                .Activate
                .Cells.Clear
                .Columns("A:A").ColumnWidth = 17
                .Columns("B:R").ColumnWidth = 6
                Cells(2, 1).Select
                .Paste
            End With
            .parentWindow.clipboardData.clearData "Text"
        End If
    End With
End Sub

capture

**Sebphyto** · 27/07/2015, 19h50

Voili voilou

Nom : Capture.PNG
Affichages : 695
Taille : 32,8 Ko

**patricktoulon** · 27/07/2015, 19h52

bien c'est une affaire qui roule tout ca
allez 61
synthese sebphyto

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
 
Sub testesimple61()
    Dim z As Long, pluss As Long, dicoseb, dicopat, mesTRREF, listPRnst, MESTH, docTemp
    listPRnst = Array("Bilto :", "Agence TIP :", "Top Entraineurs : ", "Stato Turf : ", "Paris Turf : ")
    Set dicoseb = CreateObject("Scripting.Dictionary")
    Set dicopat = CreateObject("Scripting.Dictionary")
    Set docTemp = CreateObject("htmlfile")
    URL = "<a href="http://www.pronostics-turf.info/fg-pronostics-presse.php" target="_blank">http://www.pronostics-turf.info/fg-p...ics-presse.php</a>"
    Set IE = CreateObject("internetexplorer.application")
    With IE:
        .navigate URL
        'IE.Visible = True:
        Do: DoEvents: Loop While .readystate <> 4 Or .busy
        codehtml = .document.body.innerhtml
        'on crée une table avec les source choisie
        Set mesTR = .document.getelementsbytagname("tr")
        For i = 0 To mesTR.Length - 1
            For p = 0 To UBound(listPRnst)
                If InStr(mesTR(i).innertext, listPRnst(p)) > 0 Then codetable = codetable & mesTR(i).outerhtml
            Next
        Next
        codetable = "<table ID=tableref>" & codetable & "</table>"
        'on créé une table avec la synthese
        ligneplace = "<TR bgcolor=""#BDBDBD"" id=Places><TH>Places</TH>"
        lignecheval = "<TR bgcolor=""#BDBDBD"" id=cheval><TH>Cheval</TH>"
        For i = 1 To 17
            ligneplace = ligneplace & "<TH>" & i & "</TH>"
            lignecheval = lignecheval & "<TH>" & i & "</TH>"
        Next
        ligneplace = ligneplace & "</TR>"
        lignecheval = lignecheval & "</TR>"
        For i = 0 To mesTR.Length - 1
            If InStr(mesTR(i).innertext, "Synthèse") > 0 Then
                For Each elem In mesTR(i).Children: elem.innerhtml = elem.innertext: Next
                mesTR(i).ID = "synthW"
                codesynth = ligneplace & mesTR(i).outerhtml & "<TR></TR>" & lignecheval
            End If
        Next
        'on prepare la lignes des syntheses pat et seb
        suitesynth = suitesynth & "<tr id=fois><th> X fois cité</th>" & Application.Rept("<th>0</th>", 17) & vbCrLf
        suitesynth = suitesynth & "<tr id=synthS><th> synthese sebphyto</th>" & Application.Rept("<th></th>", 17) & vbCrLf
        suitesynth = suitesynth & "<tr id=synthP><th> synthese patrick</th>" & Application.Rept("<th></th>", 17) & vbCrLf
        codesynth = "<table>" & codesynth & suitesynth & "</table>"
        'on supprime le script 3 et on récupère le debut
        lscript = Split(codehtml, "<script")
        codehtml = Replace(codehtml, Split(lscript(3), "</script>")(0) & "</script>", "")
        docTemp.body.innerhtml = codehtml
        DEBUT = Split(Split(docTemp.body.innerhtml, "Résultat")(1), "<TABLE")(0)
        docTemp.body.innerhtml = DEBUT
        textedebut = "": textedebut = Replace(Replace(docTemp.body.innertext, " - ", "-"), vbCrLf, " ")
        Set docTemp = Nothing
        .Quit
    End With
    'model seb
   'textedebut = "QUINTE Arrivée du QUINTE PMU d'aujourd'hui Lundi 27 Juillet 2015: 14-5-9/11-7 27/07/2015 [Il est 18:46:41]-Course 4590 PRONOSTICS PRESSE HIPPIQUE POUR LE QUINTE PMU: Prix DU BOIS BRANDIN-16 partants à CHANTILLY Mardi le 28-07-2015, Réunion 1 Course 3 Départ: 13h50 (allocation: 60000€) Plat PRONOSTICS DE LA PRESSE (Revue de Presse) de pronostics-turf.info "
    'model pat
    'textedebut =QUINTE Arrivée du QUINTE PMU d'aujourd'hui Lundi 27 Juillet 2015: 14-5-9/11-7 27/07/2015 [Il est 17:42:03]-Course 4590 QUINTE: Prix DU BOIS BRANDIN à CHANTILLY Mardi le 28-07-2015, Réunion 1 Course 3 Départ: 13h50 (allocation: 60000€) Plat PRONOSTICS DE LA PRESSE (Revue de Presse) de pronostics-turf.info
    ' date de la precedente course
    oldate = Split(Split(Replace(textedebut, "hui", "hier"), "hier ")(1), ":")(0)
    daystring = Split(oldate, " ")(0)
    oldate = Format(Split(oldate, daystring)(1), "dd/mm/yyyy")
    newdate = Format(Split(Split(textedebut, " le ")(1), ",")(0), "dd/mm/yyyy")
    oldarrivée = Replace(Split(Split(textedebut, ": ")(1), " ")(0), "/", "-")
 
    nomprix = "Prix" & Split(Split(textedebut, "Prix")(1), "à")(0)
    If InStr(nomprix, "partants") > 0 Then
        nomprix = Split(nomprix, "-")(0)
        nbpartant = Replace(Split(Split(textedebut, "partants")(0), nomprix)(1), "-", "")
    End If
    HiPPo = Split(Split(textedebut, "à ")(1), " ")(0)
    RC = "R" & Replace(Split(Split(textedebut, "Réunion ")(1), " Départ")(0), " Course ", "C")
    DsP = Split(Split(textedebut, "€) ")(1), " PRONOSTICS")(0)
    codedebut = codedebut & "<a>" & " date de la course precedente : " & oldate & "</a><br>"
    codedebut = codedebut & "<a>" & " arrivée de la course precedente : " & oldarrivée & "</a><br>"
    codedebut = codedebut & "<a>" & " date de la nouvelle course : " & newdate & "</a><br>"
    codedebut = codedebut & "<a>" & " Hippodrome  de la nouvelle course : " & HiPPo & "</a><br>"
    codedebut = codedebut & "<a>" & " prix de la nouvelle course : " & nomprix & "</a><br>"
    codedebut = codedebut & "<a>" & " Réunion et course de la nouvelle course : " & RC & "</a><br>"
    codedebut = codedebut & "<a>" & " discipline  de la nouvelle course : " & DsP & "</a><br>"
    codedebut = codedebut & "<a>" & " nombre de partant  de la nouvelle course : " & nbpartant & "</a><br>"
 
 
    With CreateObject("htmlfile")
        .body.innerhtml = textedebut & "<br>" & codedebut & codetable & "<br>" & codesynth
 
        '************************************************************************************
        'nombre de fois cité dans les sources choisies
        Set mesthref = .getelementbyID("tableref").getelementsbytagname("TH")
        Set fois = .getelementbyID("fois")
        For i = 1 To 17
            For a = 0 To mesthref.Length - 1
                If Val(mesthref(a).innertext) = i Then fois.Children(i).innertext = Val(fois.Children(i).innertext) + 1
            Next
        Next
        '***************************************************************************
 'syntheze patric avec  les sources choisies par points
        Set mesTRREF = .getelementbyID("tableref").getelementsbytagname("TR")
        Set synthP = .getelementbyID("synthP")
        For i = 0 To mesTRREF.Length - 1
            For z = 1 To mesTRREF(i).Children.Length - 1
                dicopat(mesTRREF(i).Children(z).innertext) = dicopat(mesTRREF(i).Children(z).innertext) + (8 - (z - 1))
            Next
        Next
        Do
            num = num + 1: old = 0
            For Each elem In dicopat
                If dicopat(elem) > old Then old = dicopat(elem): items = elem
            Next
            'MsgBox items & " :  " & dicopat(items)
            dicopat(items) = 0
            synthP.Children(num).innertext = items
        Loop Until num = dicopat.Count
        '****************************************************************************
 Set synthS = .getelementbyID("synthS")
        Set synthW = .getelementbyID("synthW")
        Set mesthref = .getelementbyID("tableref").getelementsbytagname("TH")
' remplissage des chevauc de la ligne syntheze par point dans le dicoseb
        For i = 1 To synthW.Children.Length - 1
            If synthW.Children(i).innertext <> "" Then dicoseb(Val(synthW.Children(i).innertext)) = ""
        Next
'remplissage des point dans le dicoseb par raport au nombre de fois cité dans la table de source choisies
        For z = 0 To mesthref.Length - 1
            If dicoseb.exists(Val(mesthref(z).innertext)) Then dicoseb(Val(mesthref(z).innertext)) = Val(dicoseb(Val(mesthref(z).innertext))) + 1
        Next
'retranscription dans le meme ordre que la ligne syntheze par point dans la ligne syntheze sebphyto
        z = 0
        For lMax = 5 To 0 Step -1
            For i = 1 To synthW.Children.Length - 1
                If Val(dicoseb(Val(synthW.Children(i).innertext))) = lMax Then z = z + 1: synthS.Children(z).innertext = synthW.Children(i).innertext
            Next
        Next
        '************************************************************************************
 
        If .parentWindow.clipboardData.setData("Text", .body.innerhtml) Then
            Application.ScreenUpdating = False
            With Sheets(1)
                .Activate
                .Cells.Clear
                .Columns("A:A").ColumnWidth = 17
                .Columns("B:R").ColumnWidth = 6
                Cells(2, 1).Select
                .Paste
            End With
            .parentWindow.clipboardData.clearData "Text"
        End If
    End With
End Sub

capture

**Sebphyto** · 27/07/2015, 20h11

pas mal ça roule,
Nom : Capture.PNG
Affichages : 710
Taille : 33,0 Ko

**patricktoulon** · 27/07/2015, 20h23

pas mal !!!!

puré qu'est ce qu'il te faut

on travaille sur une page protégée contre la copie

les elements sont dynamiques et diférement placés selon IE(09,10,11)

une syntheze pour les xfois dynamique sur les sources choisies
1 syntheze perso par les point meme formule que celle de la page web mais sur les sources choisie
1 synthese selon toi mixant celle de la page web avec les x fois placés selon les sources choisies

retranscription sur sheets proprement et intelligiblement

le tout en 1 click
un artiste je vous dis moi .....un artiste

bon allez donne moi le lien de geny pour la course de demain

pal mal ..... j't'enfoutrais moi .....

c'est bon j'ai trouvé
on peu meme constitué l url puisqu'on a les données
http://www.geny.com/partants-pmu/201...u-bois-brandin

allez proto 62
une fois le boulot terminé la sub t'ouvre la page de la course sur geny

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
'http://www.geny.com/partants-pmu/2015-07-28-chantilly-pmu-prix-du-bois-brandin
Sub testesimple62()
    Dim z As Long, pluss As Long, dicoseb, dicopat, mesTRREF, listPRnst, MESTH, docTemp
    listPRnst = Array("Bilto :", "Agence TIP :", "Top Entraineurs : ", "Stato Turf : ", "Paris Turf : ")
    Set dicoseb = CreateObject("Scripting.Dictionary")
    Set dicopat = CreateObject("Scripting.Dictionary")
    Set docTemp = CreateObject("htmlfile")
    URL = "http://www.pronostics-turf.info/fg-pronostics-presse.php"
    Set ie = CreateObject("internetexplorer.application")
    With ie:
        .navigate URL
        'IE.Visible = True:
        Do: DoEvents: Loop While .readystate <> 4 Or .busy
        codehtml = .document.body.innerhtml
        'on crée une table avec les source choisie
        Set mesTR = .document.getelementsbytagname("tr")
        For i = 0 To mesTR.Length - 1
            For p = 0 To UBound(listPRnst)
                If InStr(mesTR(i).innertext, listPRnst(p)) > 0 Then codetable = codetable & mesTR(i).outerhtml
            Next
        Next
        codetable = "<table ID=tableref>" & codetable & "</table>"
        'on créé une table avec la synthese
        ligneplace = "<TR bgcolor=""#BDBDBD"" id=Places><TH>Places</TH>"
        lignecheval = "<TR bgcolor=""#BDBDBD"" id=cheval><TH>Cheval</TH>"
        For i = 1 To 17
            ligneplace = ligneplace & "<TH>" & i & "</TH>"
            lignecheval = lignecheval & "<TH>" & i & "</TH>"
        Next
        ligneplace = ligneplace & "</TR>"
        lignecheval = lignecheval & "</TR>"
        For i = 0 To mesTR.Length - 1
            If InStr(mesTR(i).innertext, "Synthèse") > 0 Then
                For Each elem In mesTR(i).Children: elem.innerhtml = elem.innertext: Next
                mesTR(i).ID = "synthW"
                codesynth = ligneplace & mesTR(i).outerhtml & "<TR></TR>" & lignecheval
            End If
        Next
        'on prepare la lignes des syntheses pat et seb
        suitesynth = suitesynth & "<tr id=fois><th> X fois cité</th>" & Application.Rept("<th>0</th>", 17) & vbCrLf
        suitesynth = suitesynth & "<tr id=synthS><th> synthese sebphyto</th>" & Application.Rept("<th></th>", 17) & vbCrLf
        suitesynth = suitesynth & "<tr id=synthP><th> synthese patrick</th>" & Application.Rept("<th></th>", 17) & vbCrLf
        codesynth = "<table>" & codesynth & suitesynth & "</table>"
        'on supprime le script 3 et on récupère le debut
        lscript = Split(codehtml, "<script")
        codehtml = Replace(codehtml, Split(lscript(3), "</script>")(0) & "</script>", "")
        docTemp.body.innerhtml = codehtml
        DEBUT = Split(Split(docTemp.body.innerhtml, "Résultat")(1), "<TABLE")(0)
        docTemp.body.innerhtml = DEBUT
        textedebut = "": textedebut = Replace(Replace(docTemp.body.innertext, " - ", "-"), vbCrLf, " ")
        Set docTemp = Nothing
        .Quit
    End With
    'model seb
   'textedebut = "QUINTE Arrivée du QUINTE PMU d'aujourd'hui Lundi 27 Juillet 2015: 14-5-9/11-7 27/07/2015 [Il est 18:46:41]-Course 4590 PRONOSTICS PRESSE HIPPIQUE POUR LE QUINTE PMU: Prix DU BOIS BRANDIN-16 partants à CHANTILLY Mardi le 28-07-2015, Réunion 1 Course 3 Départ: 13h50 (allocation: 60000€) Plat PRONOSTICS DE LA PRESSE (Revue de Presse) de pronostics-turf.info "
    'model pat
    'textedebut =QUINTE Arrivée du QUINTE PMU d'aujourd'hui Lundi 27 Juillet 2015: 14-5-9/11-7 27/07/2015 [Il est 17:42:03]-Course 4590 QUINTE: Prix DU BOIS BRANDIN à CHANTILLY Mardi le 28-07-2015, Réunion 1 Course 3 Départ: 13h50 (allocation: 60000€) Plat PRONOSTICS DE LA PRESSE (Revue de Presse) de pronostics-turf.info
    ' date de la precedente course
    oldate = Split(Split(Replace(textedebut, "hui", "hier"), "hier ")(1), ":")(0)
    daystring = Split(oldate, " ")(0)
    oldate = Format(Split(oldate, daystring)(1), "dd/mm/yyyy")
    newdate = Format(Split(Split(textedebut, " le ")(1), ",")(0), "dd/mm/yyyy")
    oldarrivée = Replace(Split(Split(textedebut, ": ")(1), " ")(0), "/", "-")
 
    nomprix = "Prix" & Split(Split(textedebut, "Prix")(1), "à")(0)
    If InStr(nomprix, "partants") > 0 Then
        nomprix = Split(nomprix, "-")(0)
        nbpartant = Replace(Split(Split(textedebut, "partants")(0), nomprix)(1), "-", "")
    End If
    HiPPo = Split(Split(textedebut, "à ")(1), " ")(0)
    RC = "R" & Replace(Split(Split(textedebut, "Réunion ")(1), " Départ")(0), " Course ", "C")
    DsP = Split(Split(textedebut, "€) ")(1), " PRONOSTICS")(0)
    codedebut = codedebut & "<a>" & " date de la course precedente : " & oldate & "</a><br>"
    codedebut = codedebut & "<a>" & " arrivée de la course precedente : " & oldarrivée & "</a><br>"
    codedebut = codedebut & "<a>" & " date de la nouvelle course : " & newdate & "</a><br>"
    codedebut = codedebut & "<a>" & " Hippodrome  de la nouvelle course : " & HiPPo & "</a><br>"
    codedebut = codedebut & "<a>" & " prix de la nouvelle course : " & nomprix & "</a><br>"
    codedebut = codedebut & "<a>" & " Réunion et course de la nouvelle course : " & RC & "</a><br>"
    codedebut = codedebut & "<a>" & " discipline  de la nouvelle course : " & DsP & "</a><br>"
    codedebut = codedebut & "<a>" & " nombre de partant  de la nouvelle course : " & nbpartant & "</a><br>"
 
 
    With CreateObject("htmlfile")
        .body.innerhtml = textedebut & "<br>" & codedebut & codetable & "<br>" & codesynth
 
        '************************************************************************************
        'nombre de fois cité dans les sources choisies
        Set mesthref = .getelementbyID("tableref").getelementsbytagname("TH")
        Set fois = .getelementbyID("fois")
        For i = 1 To 17
            For a = 0 To mesthref.Length - 1
                If Val(mesthref(a).innertext) = i Then fois.Children(i).innertext = Val(fois.Children(i).innertext) + 1
            Next
        Next
        '***************************************************************************
 'syntheze patric avec  les sources choisies par points
        Set mesTRREF = .getelementbyID("tableref").getelementsbytagname("TR")
        Set synthP = .getelementbyID("synthP")
        For i = 0 To mesTRREF.Length - 1
            For z = 1 To mesTRREF(i).Children.Length - 1
                dicopat(mesTRREF(i).Children(z).innertext) = dicopat(mesTRREF(i).Children(z).innertext) + (8 - (z - 1))
            Next
        Next
        Do
            num = num + 1: old = 0
            For Each elem In dicopat
                If dicopat(elem) > old Then old = dicopat(elem): items = elem
            Next
            'MsgBox items & " :  " & dicopat(items)
            dicopat(items) = 0
            synthP.Children(num).innertext = items
        Loop Until num = dicopat.Count
        '****************************************************************************
 Set synthS = .getelementbyID("synthS")
        Set synthW = .getelementbyID("synthW")
        Set mesthref = .getelementbyID("tableref").getelementsbytagname("TH")
' remplissage des chevauc de la ligne syntheze par point dans le dicoseb
        For i = 1 To synthW.Children.Length - 1
            If synthW.Children(i).innertext <> "" Then dicoseb(Val(synthW.Children(i).innertext)) = ""
        Next
'remplissage des point dans le dicoseb par raport au nombre de fois cité dans la table de source choisies
        For z = 0 To mesthref.Length - 1
            If dicoseb.exists(Val(mesthref(z).innertext)) Then dicoseb(Val(mesthref(z).innertext)) = Val(dicoseb(Val(mesthref(z).innertext))) + 1
        Next
'retranscription dans le meme ordre que la ligne syntheze par point dans la ligne syntheze sebphyto
        z = 0
        For lMax = 5 To 0 Step -1
            For i = 1 To synthW.Children.Length - 1
                If Val(dicoseb(Val(synthW.Children(i).innertext))) = lMax Then z = z + 1: synthS.Children(z).innertext = synthW.Children(i).innertext
            Next
        Next
        '************************************************************************************
 
        If .parentWindow.clipboardData.setData("Text", .body.innerhtml) Then
            Application.ScreenUpdating = False
            With Sheets(1)
                .Activate
                .Cells.Clear
                .Columns("A:A").ColumnWidth = 17
                .Columns("B:R").ColumnWidth = 6
                Cells(2, 1).Select
                .Paste
            End With
            .parentWindow.clipboardData.clearData "Text"
        End If
    End With
'http://www.geny.com/partants-pmu/2015-07-28-chantilly-pmu-prix-du-bois-brandin
URL = "http://www.geny.com/partants-pmu/" & Format(newdate, "yyyy-mm-dd") & "-" & HiPPo & "-pmu-" & Split(nomprix, "Prix")(1)
Set ie = CreateObject("internetexplorer.application")
ie.navigate URL
ie.Visible = True
End Sub

a tu essayé le proto 2

regarde cette capture le calcule par point attribués au places ganées est deja éfectués sur genie
Pièce jointe 184049

**Sebphyto** · 27/07/2015, 21h07

C la bonne page

voici le code que tu avais utiliser

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
Sub test()
    Columns("A:l").Clear
    Dim Req As Object, URL As String
    URL = "http://www.geny.com/partants-pmu/2015-05-19-longchamp-pmu-prix-des-gobelins_c714596"
    Set Req = CreateObject("microsoft.xmlhttp")
    Req.Open "POST", URL, False
    Req.setRequestHeader "Accept", "text/html, application/xhtml+xml, */*"
    Req.setRequestHeader "Accept-Language", "fr-FR"
    Req.setRequestHeader "User-Agent", "Mozilla/5.0 (compatible; MSIE 10.0; Windows NT 6.1; WOW64; Trident/6.0)"
    Req.setRequestHeader "Accept-Encoding", "gzip, deflate"
    Req.setRequestHeader "Host", "www.geny.com"
    Req.setRequestHeader "DNT", 1
    Req.setRequestHeader "Connection", "Keep - Alive"
    Req.setRequestHeader "Cookie", " JSESSIONID=3E554B80B1ABBC36A2C53EC91C219C77.raoul_1;"
    Req.send
    'MsgBox ReQ.responsetext
    Set fauxdoc = CreateObject("htmlfile")
    With fauxdoc
        .body.innerHTML = Req.responseText
         Set grouptable = .getElementsByTagName("TABLE")
         For i = 0 To grouptable.Length - 1
           If grouptable(i).ParentNode.ID = "dt_partants" Then Set matable = grouptable(i)
        Next
 
        faire = .parentWindow.clipboardData.setData("text", matable.outerHTML)
        With Sheets(1)
            Set cel = .Cells(Rows.Count, 1).End(xlUp).Offset(2, 0)
            cel.Select
            .Paste:
        End With
        faire = .parentWindow.clipboardData.clearData("text")
    End With
End Sub

Seb

**patricktoulon** · 27/07/2015, 21h11

oui je sais je l'avais garder mon fichier geny

a tu essayer le proto 62 et a tu vu ma capture d'ecran
peut on se baser sur la colonne valeur qui representent les points par la musique
oui ou non ?
tu comprends maintenant pourquoi je voulais absolument les données titres on peut s'en servir pour reconstituer l'url de la course sur geny
tu vois on en est a 300 posts je l'avais prevu des les premiers

**Sebphyto** · 27/07/2015, 21h59

a tu essayer le proto 62 et a tu vu ma capture d'ecran

A l'instant

peut on se baser sur la colonne valeur qui representent les points par la musique
oui ou non

il faut que je recalcule tout et faire la comparaison, je te redis...

tu comprends maintenant pourquoi je voulais absolument les données titres on peut s'en servir pour reconstituer l'url de la course sur geny
tu vois on en est a 300 posts je l'avais prevu des les premiers

Ouais je sais, tu est trop fort

Bon comment faire simple!!!!!

non le classement geny ne correspond pas à mon indice désolé.....

Tableau classement geny:
Nom : Capture.PNG
Affichages : 785
Taille : 29,1 Ko

Nom : Capture.PNG
Affichages : 785
Taille : 29,1 Ko

Et voici mon classement en fonction de la musique du cheval
Nom : Capture.PNG
Affichages : 689
Taille : 45,5 Ko

Comme tu peux le voir
en colonne I, on n'a la musique
on prends chaque chiffre de la musique (colonne L) et on additionne (resultat en col M) puis on divise par le nb de course (resultat en P) ce qui donne "l'indice de forme"

EX:
en ligne 2
on n'a 2p1p(14)2p
on additionne 2+1+2 (le 14 correspond à la dernière année qu'il a couru...on s'en fout)
ce qui donne =5
puis on divise 5 par le nb de course ici 3 (2+1+2)

Etc.....pour les autres

Pour info, si dans le musique on a
un D, ou un T ou un A ou un 0, alors cela signifie que
Si il a fait l'objet d'une disqualification (D), d'un arrêt (A), d'une chute (T), d'un classement supérieur à la 10è place, il faut additionner 11 points pour la course concernée.
(comme en ligne 12 et 15)

Comme tu pourras le voir la valeur de geny et la mienne n'a rien à voir
Le classement en colonne A (le mien) n'est pas du tout pareil que geny....

J'espère être assez clair

**patricktoulon** · 27/07/2015, 22h13

bon version 62 definitive
ajout de musique et point geny

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
'http://www.geny.com/partants-pmu/2015-07-28-chantilly-pmu-prix-du-bois-brandin
Sub testesimple62()
    Dim z As Long, pluss As Long, dicoseb, dicopat, mesTRREF, listPRnst, MESTH, docTemp
    listPRnst = Array("Bilto :", "Agence TIP :", "Top Entraineurs : ", "Stato Turf : ", "Paris Turf : ")
    Set dicoseb = CreateObject("Scripting.Dictionary")
    Set dicopat = CreateObject("Scripting.Dictionary")
    Set docTemp = CreateObject("htmlfile")
    url = "http://www.pronostics-turf.info/fg-pronostics-presse.php"
    Set ie = CreateObject("internetexplorer.application")
    With ie:
        .navigate url
        'IE.Visible = True:
        Do: DoEvents: Loop While .readystate <> 4 Or .busy
        codehtml = .document.body.innerhtml
        'on crée une table avec les source choisie
        Set mestr = .document.getelementsbytagname("tr")
        For i = 0 To mestr.Length - 1
            For p = 0 To UBound(listPRnst)
                If InStr(mestr(i).innertext, listPRnst(p)) > 0 Then codetable = codetable & mestr(i).outerhtml
            Next
        Next
        codetable = "<table ID=tableref>" & codetable & "</table>"
        'on créé une table avec la synthese
        ligneplace = "<TR bgcolor=""#BDBDBD"" id=Places><TH>Places</TH>"
        lignecheval = "<TR bgcolor=""#BDBDBD"" id=cheval><TH>Cheval</TH>"
        For i = 1 To 17
            ligneplace = ligneplace & "<TH>" & i & "</TH>"
            lignecheval = lignecheval & "<TH>" & i & "</TH>"
        Next
        ligneplace = ligneplace & "</TR>"
        lignecheval = lignecheval & "</TR>"
        For i = 0 To mestr.Length - 1
            If InStr(mestr(i).innertext, "Synthèse") > 0 Then
                For Each elem In mestr(i).Children: elem.innerhtml = elem.innertext: Next
                mestr(i).ID = "synthW"
                codesynth = ligneplace & mestr(i).outerhtml & "<TR></TR>" & lignecheval
            End If
        Next
        'on prepare la lignes des syntheses pat et seb
        suitesynth = suitesynth & "<tr id=fois><th> X fois cité</th>" & Application.Rept("<th>0</th>", 17) & vbCrLf
        suitesynth = suitesynth & "<tr id=synthS><th> synthese sebphyto</th>" & Application.Rept("<th></th>", 17) & vbCrLf
        suitesynth = suitesynth & "<tr id=synthP><th> synthese patrick</th>" & Application.Rept("<th></th>", 17) & vbCrLf
        codesynth = "<table>" & codesynth & suitesynth & "</table>"
        'on supprime le script 3 et on récupère le debut
        lscript = Split(codehtml, "<script")
        codehtml = Replace(codehtml, Split(lscript(3), "</script>")(0) & "</script>", "")
        docTemp.body.innerhtml = codehtml
        DEBUT = Split(Split(docTemp.body.innerhtml, "Résultat")(1), "<TABLE")(0)
        docTemp.body.innerhtml = DEBUT
        textedebut = "": textedebut = Replace(Replace(docTemp.body.innertext, " - ", "-"), vbCrLf, " ")
        Set docTemp = Nothing
        .Quit
    End With
    'model seb
    'textedebut = "QUINTE Arrivée du QUINTE PMU d'aujourd'hui Lundi 27 Juillet 2015: 14-5-9/11-7 27/07/2015 [Il est 18:46:41]-Course 4590 PRONOSTICS PRESSE HIPPIQUE POUR LE QUINTE PMU: Prix DU BOIS BRANDIN-16 partants à CHANTILLY Mardi le 28-07-2015, Réunion 1 Course 3 Départ: 13h50 (allocation: 60000€) Plat PRONOSTICS DE LA PRESSE (Revue de Presse) de pronostics-turf.info "
    'model pat
    'textedebut =QUINTE Arrivée du QUINTE PMU d'aujourd'hui Lundi 27 Juillet 2015: 14-5-9/11-7 27/07/2015 [Il est 17:42:03]-Course 4590 QUINTE: Prix DU BOIS BRANDIN à CHANTILLY Mardi le 28-07-2015, Réunion 1 Course 3 Départ: 13h50 (allocation: 60000€) Plat PRONOSTICS DE LA PRESSE (Revue de Presse) de pronostics-turf.info
    ' date de la precedente course
    oldate = Split(Split(Replace(textedebut, "hui", "hier"), "hier ")(1), ":")(0)
    daystring = Split(oldate, " ")(0)
    oldate = Format(Split(oldate, daystring)(1), "dd/mm/yyyy")
    newdate = Format(Split(Split(textedebut, " le ")(1), ",")(0), "dd/mm/yyyy")
    oldarrivée = Replace(Split(Split(textedebut, ": ")(1), " ")(0), "/", "-")
    nomprix = "Prix" & Split(Split(textedebut, "Prix")(1), "à")(0)
    If InStr(nomprix, "partants") > 0 Then
        nomprix = Split(nomprix, "-")(0)
        nbpartant = Replace(Split(Split(textedebut, "partants")(0), nomprix)(1), "-", "")
    End If
    HiPPo = Split(Split(textedebut, "à ")(1), " ")(0)
    RC = "R" & Replace(Split(Split(textedebut, "Réunion ")(1), " Départ")(0), " Course ", "C")
    DsP = Split(Split(textedebut, "€) ")(1), " PRONOSTICS")(0)
    codedebut = codedebut & "<a>" & " date de la course precedente : " & oldate & "</a><br>"
    codedebut = codedebut & "<a>" & " arrivée de la course precedente : " & oldarrivée & "</a><br>"
    codedebut = codedebut & "<a>" & " date de la nouvelle course : " & newdate & "</a><br>"
    codedebut = codedebut & "<a>" & " Hippodrome  de la nouvelle course : " & HiPPo & "</a><br>"
    codedebut = codedebut & "<a>" & " prix de la nouvelle course : " & nomprix & "</a><br>"
    codedebut = codedebut & "<a>" & " Réunion et course de la nouvelle course : " & RC & "</a><br>"
    codedebut = codedebut & "<a>" & " discipline  de la nouvelle course : " & DsP & "</a><br>"
    codedebut = codedebut & "<a>" & " nombre de partant  de la nouvelle course : " & nbpartant & "</a><br>"
 
 
    With CreateObject("htmlfile")
        .body.innerhtml = textedebut & "<br>" & codedebut & codetable & "<br>" & codesynth
 
        '************************************************************************************
        'nombre de fois cité dans les sources choisies
        Set mesthref = .getelementbyid("tableref").getelementsbytagname("TH")
        Set fois = .getelementbyid("fois")
        For i = 1 To 17
            For a = 0 To mesthref.Length - 1
                If Val(mesthref(a).innertext) = i Then fois.Children(i).innertext = Val(fois.Children(i).innertext) + 1
            Next
        Next
        '***************************************************************************
        'syntheze patric avec  les sources choisies par points
        Set mesTRREF = .getelementbyid("tableref").getelementsbytagname("TR")
        Set synthP = .getelementbyid("synthP")
        For i = 0 To mesTRREF.Length - 1
            For z = 1 To mesTRREF(i).Children.Length - 1
                dicopat(mesTRREF(i).Children(z).innertext) = dicopat(mesTRREF(i).Children(z).innertext) + (8 - (z - 1))
            Next
        Next
        Do
            num = num + 1: old = 0
            For Each elem In dicopat
                If dicopat(elem) > old Then old = dicopat(elem): items = elem
            Next
            'MsgBox items & " :  " & dicopat(items)
            dicopat(items) = 0
            synthP.Children(num).innertext = items
        Loop Until num = dicopat.Count
        '****************************************************************************
        Set synthS = .getelementbyid("synthS")
        Set synthW = .getelementbyid("synthW")
        Set mesthref = .getelementbyid("tableref").getelementsbytagname("TH")
        ' remplissage des chevauc de la ligne syntheze par point dans le dicoseb
        For i = 1 To synthW.Children.Length - 1
            If synthW.Children(i).innertext <> "" Then dicoseb(Val(synthW.Children(i).innertext)) = ""
        Next
        'remplissage des point dans le dicoseb par raport au nombre de fois cité dans la table de source choisies
        For z = 0 To mesthref.Length - 1
            If dicoseb.exists(Val(mesthref(z).innertext)) Then dicoseb(Val(mesthref(z).innertext)) = Val(dicoseb(Val(mesthref(z).innertext))) + 1
        Next
        'retranscription dans le meme ordre que la ligne syntheze par point dans la ligne syntheze sebphyto
        z = 0
        For lMax = 5 To 0 Step -1
            For i = 1 To synthW.Children.Length - 1
                If Val(dicoseb(Val(synthW.Children(i).innertext))) = lMax Then z = z + 1: synthS.Children(z).innertext = synthW.Children(i).innertext
            Next
        Next
        '************************************************************************************
code = .body.innerhtml
        'If .parentWindow.clipboardData.setData("Text", .body.innerhtml) Then
           ' Application.ScreenUpdating = False
           ' With Sheets(1)
               ' .Activate
                '.Cells.Clear
                '.Columns("A:A").ColumnWidth = 17
                '.Columns("B:R").ColumnWidth = 6
               ' Cells(2, 1).Select
                '.Paste
           ' End With
           ' .parentWindow.clipboardData.clearData "Text"
        'End If
    End With
    'http://www.geny.com/partants-pmu/2015-07-28-chantilly-pmu-prix-du-bois-brandin
    url = "http://www.geny.com/partants-pmu/" & Format(newdate, "yyyy-mm-dd") & "-" & HiPPo & "-pmu-" & Split(nomprix, "Prix")(1)
    musiquegeny url, code
End Sub
Sub musiquegeny(url, code)
    Set ReQ = CreateObject("microsoft.xmlhttp")
    ligpointgeny = "<tr ID=Pgeny><th> point musique geny</th>"
    ligmusiquegeny = "<tr ID=Mgeny><th> musique geny</th>"
    ligchev = "<tr bgcolor=""#BDBDBD""><th> cheval</th>"
    ReQ.Open "POST", url, False
    ReQ.setRequestHeader "User-Agent", "Mozilla/5.0 (compatible; MSIE 10.0; Windows NT 6.1; WOW64; Trident/6.0)"
    ReQ.send
    With CreateObject("htmlfile")
        .write ReQ.responsetext
        MsgBox .body.innertext
        Set matable = .getelementbyid("dt_partants")
        Set mestr = matable.getelementsbytagname("tr")
         For i = 1 To mestr.Length - 1
         ligchev = ligchev & "<th>" & i & "</th>"
         ligpointgeny = ligpointgeny & "<th>" & mestr(i).Children(12).innertext & "</th>"
    ligmusiquegeny = ligmusiquegeny & "<th>" & mestr(i).Children(11).innertext & "</th>"
         Next
      ligpointgeny = ligpointgeny & "</tr>"
    ligmusiquegeny = ligmusiquegeny & "</tr>"
     ligchev = ligchev & "</tr>"
     .body.innerhtml = code & "<br>" & "<table>" & ligchev & ligpointgeny & ligmusiquegeny & "</table>"
 
     If .parentWindow.clipboardData.setData("Text", .body.innerhtml) Then
            Application.ScreenUpdating = False
            With Sheets(1)
                .Activate
                .Cells.Clear
                .Columns("A:A").ColumnWidth = 17
                .Columns("B:R").ColumnWidth = 10
                Cells(Rows.Count, 1).End(xlUp).Offset(2, 0).Select
                .Paste
            End With
            .parentWindow.clipboardData.clearData "Text"
        End If
 
    End With
End Sub

j'ai compris ton system mais il est harchi faux
si il y en a 1 qui fait 1p2p1p10p11p4p avec ton calcul il sera mauvais pourtant a y regarder de plus pres
enfin on verra bien

**Sebphyto** · 27/07/2015, 22h32

Ok pour ça c déjà très bien....
mais à regarder ton calcul
cela me donne 29 que je divise par 6 = 4.83 et celui la en fonction des autres serai bon car inférieur à 5, oui j'avais oubié de te dire que l'indice de confiance du cheval doit être inférieur à 5

Nom : Capture.PNG
Affichages : 699
Taille : 39,9 Ko