Taille du fichier en exponentiel suite requete puis optimisation

**patricktoulon** · 28/07/2015, 22h50

j'ai modifié la table geny
tu a les deux en lettre et enchiffre
ca te permettra d'avoir un regard dessus

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
'http://www.geny.com/partants-pmu/2015-07-28-chantilly-pmu-prix-du-bois-brandin
Sub testesimple64()
    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 = LCase("http://www.geny.com/partants-pmu/" & Format(newdate, "yyyy-mm-dd") & "-" & HiPPo & "-pmu-" & Replace(Trim(nomprix), " ", "-"))
    Debug.Print url
 
    musiquegeny url, code
End Sub
Sub musiquegeny(url, code)
    Set ReQ = CreateObject("microsoft.xmlhttp")
    ligmusiquegeny = "<tr ID=Mgeny><th> musique geny</th>"
   ligpointgeny = "<tr ID=Pgeny><th>musique en chiffre </th>"
 ligchev = "<tr bgcolor=""#BDBDBD""><th> cheval</th>"
    confiance = "<tr bgcolor=""#BDBDBD""><th> Confiance</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 c = 0 To mestr(0).Children.Length - 1
            If mestr(i).Children(c).innertext = "Musique" Then ind = c + 3
 
        Next
        numchev = mestr.Length
 
        For i = 1 To mestr.Length - 1
            ligchev = ligchev & "<th>" & i & "</th>"
 
            musique = ""
            musique = Replace(Replace(mestr(i).Children(ind).innertext, asup, ""), "()", "")
            musique = Replace(Replace(Replace(Replace(Replace(mestr(i).Children(ind).innertext, "Dpag", 11), "T", 11), "A", 11), 0, 11), "D", 11)
            musique = Replace(Replace(Replace(Replace(musique, "a", "+"), "m", "+"), "p", "+"), "R", 11)
            If InStr(musique, "(") > 0 Then asupp = "(" & Split(Split(musique, "(")(1), ")")(0) & ")"
            musique = Replace(musique, asupp, "") & "0"
            div = Split(musique, "+")
            resultat = 0
            For pt = 0 To UBound(div): resultat = resultat + Val(div(pt)): Next
            resultat = resultat / UBound(div)
            ligpointgeny = ligpointgeny & "<th>" & musique & "</th>"
            ligmusiquegeny = ligmusiquegeny & "<th>" & mestr(i).Children(ind).innertext & "</th>"
            confiance = confiance & "<th>" & resultat & "</th>"
        Next
        ligpointgeny = ligpointgeny & "</tr>"
        ligmusiquegeny = ligmusiquegeny & "</tr>"
        ligchev = ligchev & "</tr>"
        confiance = confiance & "</tr>"
        titre = "<tr><th colspan=" & numchev & ">Bilan de Geny course</th></tr>"
        .body.innerhtml = code & "<br>" & "<table id=geny>" & titre & ligchev & ligpointgeny & ligmusiquegeny & confiance & "</table>"
        .getelementbyid("geny").Style.Border = "2px  solid " & "#088A08"
        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(2, 1).Select
                .Paste
            End With
            .parentWindow.clipboardData.clearData "Text"
        End If
    End With
End Sub

ok bonne nuit a demain

**patricktoulon** · 29/07/2015, 13h59

Bonjour sebphyto

bon comme on a eu des soucis avec geny bien que ca fonctionne maintenant au cas ou ca changerait j'ai prevu de pouvoir bloquer geny sans bloquer le reste du code

donc geny est devenu une fonction qui renvoie le string du code html geny dans la sub 65

dans la sub 65 il te suffit de mettre en commentaire 1 ligne pour stopper geny (au cas ou)

maintenant si tu a tout comme tu veux on passe a la BDD si tu veux bien sur

allez 65!!!!

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
'http://www.geny.com/partants-pmu/2015-07-28-chantilly-pmu-prix-du-bois-brandin
Sub testesimple65()
    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
 urlG = LCase("http://www.geny.com/partants-pmu/" & Format(newdate, "yyyy-mm-dd") & "-" & HiPPo & "-pmu-" & Replace(Trim(nomprix), " ", "-"))
    code2 = code
 '///////////////////////////////////////////////////////////////////////////////////////
 'il te suffit de bloquer cette ligne pour ne pas se servir de geny
   code2 = suite_avec_geny(urlG, code)
'////////////////////////////////////////////////////////////////////////////////////////
        If .parentWindow.clipboardData.setData("Text", code2) Then
         Application.ScreenUpdating = False
         With Sheets(1)
         .Activate
        .Cells.Clear
        .Columns("A:A").ColumnWidth = 17
        .Columns("B:R").ColumnWidth = 10
         Cells(2, 1).Select
        .Paste
         End With
         .parentWindow.clipboardData.clearData "Text"
        End If
    End With
 
End Sub
Function suite_avec_geny(url, code)
    Set ReQ = CreateObject("microsoft.xmlhttp")
    ligmusiquegeny = "<tr ID=Mgeny><th> musique geny</th>"
   ligpointgeny = "<tr ID=Pgeny><th>musique en chiffre </th>"
 ligchev = "<tr bgcolor=""#BDBDBD""><th> cheval</th>"
    confiance = "<tr bgcolor=""#BDBDBD""><th> Confiance</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 c = 0 To mestr(0).Children.Length - 1
            If mestr(i).Children(c).innertext = "Musique" Then ind = c + 3
 
        Next
        numchev = mestr.Length
 
        For i = 1 To mestr.Length - 1
            ligchev = ligchev & "<th>" & i & "</th>"
 
            musique = ""
            musique = Replace(Replace(mestr(i).Children(ind).innertext, asup, ""), "()", "")
            musique = Replace(Replace(Replace(Replace(Replace(mestr(i).Children(ind).innertext, "Dpag", 11), "T", 11), "A", 11), 0, 11), "D", 11)
            musique = Replace(Replace(Replace(Replace(musique, "a", "+"), "m", "+"), "p", "+"), "R", 11)
            If InStr(musique, "(") > 0 Then asupp = "(" & Split(Split(musique, "(")(1), ")")(0) & ")"
            musique = Replace(musique, asupp, "") & "0"
            div = Split(musique, "+")
            resultat = 0
            For pt = 0 To UBound(div): resultat = resultat + Val(div(pt)): Next
            resultat = resultat / UBound(div)
            ligpointgeny = ligpointgeny & "<th>" & musique & "</th>"
            ligmusiquegeny = ligmusiquegeny & "<th>" & mestr(i).Children(ind).innertext & "</th>"
            confiance = confiance & "<th>" & resultat & "</th>"
        Next
        ligpointgeny = ligpointgeny & "</tr>"
        ligmusiquegeny = ligmusiquegeny & "</tr>"
        ligchev = ligchev & "</tr>"
        confiance = confiance & "</tr>"
        titre = "<tr><th colspan=" & numchev & ">Bilan de Geny course</th></tr>"
        .body.innerhtml = code & "<br>" & "<table id=geny>" & titre & ligchev & ligpointgeny & ligmusiquegeny & confiance & "</table>"
        .getelementbyid("geny").Style.Border = "2px  solid " & "#088A08"
        suite_avec_geny = .body.innerhtml
 
 
End With
End Function

**Sebphyto** · 29/07/2015, 14h12

Bonjour Patrick,
N étant pas chez moi, je ne pourrais pas apporter grand chose de suite, je rentre en fin après midi��

Mais oui on peut passer a la bdd.
Merci encore pour tout

Seb

**patricktoulon** · 29/07/2015, 18h16

attention la ligne texdebut a encre changée aujourd'hui
probleme pour le rc et discipline (pas de discipline!!)
j'ai résolu
je t'attends

QUINTE Arrivée du QUINTE PMU d'aujourd'hui Mercredi 29 Juillet 2015: 6-1-12-7-5 29/07/2015 [Il est 17:37:26]-Course 4592 QUINTE: Prix DE LA PLAINE DE CAEN à DEAUVILLE Jeudi le 30-07-2015, Réunion 1 Course 3 PRONOSTICS DE LA PRESSE (Revue de Presse) de pronostics-turf.info

**Sebphyto** · 29/07/2015, 20h55

Désolé pour la fin d'AM, mais j'ai été pris...

Je viens d'essayer le test65, et je pense que l'erreur que tu parles, je l'ai eu aussi ici

Code :

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

DsP = Split(Split(textedebut, "€) ")(1), " PRONOSTICS")(0)

erreur 9 "indice n'appartient etc...."

Avant de passer à la bdd, il serai bien de ranger du plus petit au plus grand l'indice de confiance, comme çà cela donnerai une autre forme de prono, que l'on pourrais après ranger comme les autres dans la bdd...Non? enfin du moins cela serai plus facile visuellement .....

Seb

Ps: j'aimerai vraiment que tu me réponds là-dessus

Crois-tu que pour cela je dois ouvrir un autre post afin de ne pas polluer celui-ci, j'attends ta réponse pour faire soit l'un soit l'autre?
Je suis en train de regarder comment je peux simuler par exemple:

je prend les 5 1er du prono (ou 6 ou 7 ou 8), et regarde combien de chevaux j'ai à l'arrivée, si dans cette sélection j'ai le trio, le ZE4, etc et si j'ai il calcule selon le rapport ce que je gagne moins la mise. après ce qu'il serait bien c d'appliquer une montante (choix selon plusieurs sortes de montante) et voir le rendement toujours moins les mises.....bref....c pas si simple car j'aimerai l'appliquer à ce fichier, et à d'autre, une fonction peut-être, je sais pas par quoi commencer.

**patricktoulon** · 29/07/2015, 21h12

il n'y avais pas que le dsp il y avais aussi le RC mais sans gravité j'ai ajouté cette possibilité aussi

avnd de retripatouiller le geny dis mois quelle ligne doit etre rapatriée dans BDD
un petit apercu de comment ca se montre chez moi
pour la course de demain
prono
Pièce jointe 184257

rendu dans la BDD
Pièce jointe 184258

j'ai envoyé la ligne synthese sebphyto
des que le prono est atrapé il envoie l'arrivée de la precedente course dans la bdd
reste la mfc
je regarde pour le classement geny confiance

**Sebphyto** · 29/07/2015, 21h43

il n'y avais pas que le dsp il y avais aussi le RC mais sans gravité j'ai ajouté cette possibilité aussi

non exact...

C'est bon pour moi, par contre tu avais parlé qu'il serai bien de prendre en compte également ta synthèse et du coup celle de confiance (la mienne), mais pour ranger dan la bdd, je ne vois pas bien comment faire, à part mettre cela comme ça

Mais si tu as une idée je suis preneur....

des que le prono est attrapé il envoie l'arrivée de la précédente course dans la bdd

Niquel

**patricktoulon** · 29/07/2015, 23h04

re
ligne synthese confiance (du plus petit au plus grand )c'est fait !!!
Pièce jointe 184266

transcription sur BDD c'est fait!!!

Pièce jointe 184267

avant qur tu arrive a faire faire la meme chose a windev en 1 clic et moins de 2 seconde c'est plus des chevaux qui aura sur les hippodrome c'est des "youpaligoulatriton"

youpaligoulatriton: type crustacoanimal :espece de tortue ailée a 6 pattes et 3 nez decouverte en 2635 100 apres l'armagedon provoqué par le pet de ma grand mere un soir de chocroute,les retombées radioactive ayant permis a la vie de revenir sur terre

lol!!!!

**Sebphyto** · 29/07/2015, 23h16

Trop trop balaise que tu es....

avant qur tu arrive a faire faire la meme chose a windev en 1 clic et moins de 2 seconde c'est plus des chevaux qui aura sur les hippodrome c'est des "youpaligoulatriton"

Ouais c clair, je ne suis qu'a la lecture du tuto....

youpaligoulatriton: type crustacoanimal :espece de tortue ailée a 6 pattes et 3 nez decouverte en 2635 100 apres l'armagedon provoqué par le pet de ma grand mere un soir de chocroute,les retombées radioactive ayant permis a la vie de revenir sur terre

Excellent

Je la connaissais pas cela.....

Seb

**patricktoulon** · 29/07/2015, 23h27

moi non plus je connais pas on est qu'en 2015

je vais maintenant finioler tout ca et faire la MFC et y ajouter une fonction surprise

on verra ca demain

en tout cas maintenant on peut deja comparer des que la course est arrivé

en tout le code va te faire peur

ya t il autre chose que tu voudrais ajouter

au fait !!! NC veut dire "Non Comuniqué" pour la DsP

**Sebphyto** · 30/07/2015, 08h59

Bonjour Patrick,

Non je ne vois pas quoi ajouter d'autre, à par la requête pour récupérer les rapports sur theturf, je crois que tout est complet, tu as franchement dépassé ce que j'espérai

. (pourrais-je avoir ton superbe code???

)

Je devrais avoir un peu plus de dispo aujourd'hui...normalement...

Mais je crois que tu as encore un autre projet en cours entre nous, et certainement pleins d'autres à côté....

Après moi, je regarde pour mon simulateur de gain en fonction de différents types de jeux, comme je t'ai parlé plus haut.....je regarde comment construire la structure avant toutes choses....

Pour en revenir à mes choix de pronos, pareil pour l'instant, mais je pense qu'avec le projet que tu as en cours sur l'analyse de plusieurs pronostiqueurs cela nous éclairera....

J'ai également le projet, tu sais avec mes mails qui t'ont planté ta boite mail, avec mon log, et bien j'en suis venu à la saisie manuelle car pas de possibilité de récupérer directement dans le logiciel les pronos, enfin du moins j'en ai pas trouvé...( de très bon prono d'ailleurs, soit dit en passant, dommage de ne pas pouvoir les exploiter directement). Pour ces pronos, je n'aurais pas de recul, car la bdd2015, te fais planté ton Pc, et en version XLS, celle-ci est trop grande pour le poster ici....bref...

Et enfin j'ai l'autre fichier excel que l'on m'a donné, celui dont je t'ai parlé, avec de récup web, qui ne sont plus d'actualités car ce sont des querytables, et que le site n'accepte plus ce genre de requête...Bref j'ai réussi, à ta façon, d'extraire certaines données, mais maintenant il faut que je cherche ce qui récupère dans cette requête en fonction du code....pas simple....

Voili voilou...

Seb

**patricktoulon** · 30/07/2015, 16h45

BONJOUR SEBPHYTO

Aujourd'hui je me suis penché sur d'autre projets ayant passer beaucoup de temps sur le tiens j'ai pris du retard sur d'autres

je te le donnerais quand il sera parfaitement au point et qu'il n'y aura plus d'erreur a gérer

ensuite pour récupérer les prono a la main sur ton log perso j'en vois pas l'utilité
tu a vec le site sur le quel on travaillle maintenant 51 sources pour moi il y a largement de quoi faire
et l'anné prochaine tes amis qui te font payer une daube (en terme de logiciel ) tu les envoie ch....

perso c'est comme ca que je pense

je reprend donc ce projet en soirée
A +

**Sebphyto** · 30/07/2015, 16h57

Salut Patrick,

Aujourd'hui je me suis penché sur d'autre projets ayant passer beaucoup de temps sur le tiens j'ai pris du retard sur d'autres

Tu as bien raison ça change un peu de DADA

je te le donnerais quand il sera parfaitement au point et qu'il n'y aura plus d'erreur a gérer

Ok pas de souci, merci

tu as avec le site sur le quel on travaille maintenant 51 sources

En réfléchissant bien, tu 'es pas dans le faux, il y aura certainement de bonnes sources..

Une petite question:
Pour le fichier que l'on m'a passé les requêtes se faisaient en Querytable (table 1, 2,3, etc...)
Comment puis-je savoir sur un page Web à quelle table cela correspond, Est-ce que dans le code html du site, la première balise <Table> correspond en query à la 1ère???

Seb

**patricktoulon** · 30/07/2015, 19h38

non ca ne corespond pas
comme je l'ai dis il y a un moment deja les querytable ne correspondent plus vraiment au type de page html d'aujourd'hui c'est pour cela que je n'utilise au grand jamais ce composant

bon allez je n'ai pas fait l'enregistrment mais voila reste plus que les gains quel'on peut audsi récupérer sur le meme site

teste ce fichier que j'ai concu specialement pour toi
tu n'a qu'une chose a faire c'est cliquer sur le bouton rouge ,attend ,regarde point barre

65 kilo moins de 2 seconde chez moi et regarde tout ce ce qu'il fait

**Sebphyto** · 30/07/2015, 22h10

Re,

Bon tant pis pour les "tables"....

Sinon ton fichier c le top, aux petits oignons....

Le top de chez top

Un grand merci à toi, si seulement je pouvais faire quelque chose en retour.....

Merci simplement...

Seb

Ps: Bon on fait quoi maintenant????

Ahhhh, Je sais la récup des rapports

par la suite, il serait bien qu'il colorie le rapport (trio, couplé, etc...) si l'on n'a gagné, et on pourrait le faire évoluer pour qu'il calcul le gain en fonction de la mise en fonction d'une gestion financière!!!
J'ai déjà mon idée, de plus cela m'aiderai pour mon autre projet de simulation, alors soit on continue sur ce fil soit j'ouvre une autre discussion????

**patricktoulon** · 30/07/2015, 22h20

re
maintenant tu regarde ce lien et tu me dis si les tableaux de gains de suffisent pour ta BDD(sheets("archive"))

tu clique sur le titre en jaune pour une autre date
http://www.pronostics-turf.info/cour...rse-du-pmu.php

t'en fait pas pour toutes ces manip moije les eleimines apres

**Sebphyto** · 30/07/2015, 22h25

J'ai éditer mon post précedent, je sais pas si tu l'as lu??

Sinon oui ca va, c du PMU et non de ZEturf, mais bon, les mises ne sont pas les mêmes ni les rapports...mais si c plus simple pour toi...c dommage car pour zeturf on avait déjà le code....

Seb

**patricktoulon** · 30/07/2015, 23h00

non on vais pas tout le code

pour zeturf on avait les id de course et il on present dans l'url on l'a pas
il faudrait tout reprendre a zero de la meme maniere lien1 lien2 lien3 etc bref une uzine a gaz
on peut tenter pour le fun

essaie d'en faire un puisque tu les a encore toi zeturf
essaie de reprendre l'idée des lien1,2,3 et de pouvoir récupérer le lien de la page rapport de la course en ayant que le nom du prix

**Sebphyto** · 30/07/2015, 23h04

Jolie défi que tu me lances là, j'apprécie....

OK pour ça j'essai et revient vers toi pour te dire...

Laisse moi un peu de temps si tu veux bien....

Seb

**patricktoulon** · 30/07/2015, 23h25

c'est bon j'ai trouvé comment faire pour trouver la page des raports de course sur zeturf

encore une fois j'ai eu bien raison de ne pas avancer tant que l'on avait pas toutes les données de la ligne

alors 1 aller ici"http://www.zeturf.fr/fr/resultats-et-rapports/?day=2015-07-28"

popur cela récupérer oldate et la retransformer en ce format (en rouge dans l'url)

des que la page est accessible aller au nom de l'hippodrome (on l'a !!)

ensuite des que l'on arrive a la page des course recupérer le lien dans le nom du prix ( ca on l'a aussi)
et hop!! on est dans la page des raports de la course

voila essai d'automatiser ca tu a largement vu les exemples que je t'ai donné

Taille du fichier en exponentiel suite requete puis optimisation [XL-2013]

Macros et VBA Excel

Discussions similaires

Partager

Partager