Taille du fichier en exponentiel suite requete puis optimisation

**patricktoulon** · 26/07/2015, 20h44

a ben voila que ca marche plus

**Sebphyto** · 26/07/2015, 20h50

c un truc de dingue

le code 48 fonctionne

et le 54 pas

qui a t-il eu de changer entre les deux???

**patricktoulon** · 26/07/2015, 20h52

au niveau de l'erreur rien du tout c'est resté identique
bon laisse moi reposer car travailler sur 2 model en meme temps sans avoir le rendu du 2 eme j'ai la tete qui fume moi

**Sebphyto** · 26/07/2015, 20h57

tu m'étonnes, idem pour moi, c un truc de fou se machin.......

**patricktoulon** · 26/07/2015, 20h59

mais il y a que chez toi que ca fait ca c'est bizare

**Sebphyto** · 26/07/2015, 21h03

je ne suis pas comme tout le monde, si tu me connaissais en réel, tu le serais lolllllllllllllllllll

**patricktoulon** · 26/07/2015, 22h59

non c'est pas un truc de fou c'est pire
mais je l'ai envisagé des que j'ai compris que l'on travaillais pas sur le meme code html

si je galère ca n'est pas parceque j'ai pas compris c'est parceque j'essaie de faire un code generique qui fonctionne chez toi et moi sans rienchanger c'est ca qui est le plus difficile

tiens essai le comme ca
change prono(0) pour toi

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
Sub testesimple57()
    Dim z As Long, pluss As Long, dicoseb, dicopat, mesTRREF, listPRnst, MESTH, docTemp
    listPRnst = Array("Bilto :", "Agence TIP :", "Top Entraineurs : ", "Stato Turf : ", "Paris Turf : ")
    Sheets(1).Cells.ClearContents
    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
        For i = 0 To mesTR.Length - 1
            If InStr(mesTR(i).innertext, "Synthèse") > 0 Then
                mesTR(i - 4).ID = "places"
                 mesTR(i - 4).outerhtml = Replace(mesTR(i - 4).outerhtml, mesTR(i - 4).Children(mesTR(i - 4).Children.Length - 1).outerhtml, "")
                ligncheval = Replace(mesTR(i - 4).outerhtml, "Places", "Cheval")
               mesTR(i).ID = "synthW"
                codesynth = codesynth & mesTR(i - 4).outerhtml & mesTR(i).outerhtml
            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></th>", 17) & vbCrLf
        suitesynth = suitesynth & ligncheval & 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
        textedebut = Split(Split(docTemp.body.innertext, "Résultat")(1), "PRONOSTICS")(0)
        Set docTemp = Nothing
        .Quit
    End With
 
    With CreateObject("htmlfile")
        .body.innerhtml = textedebut & codetable & "<br>" & codesynth
        If .parentWindow.clipboardData.setData("Text", .body.innerhtml) Then
            Application.ScreenUpdating = False
            With Sheets(1)
                .Activate
                '.Cells.Clear
                Cells(Rows.Count, 1).End(xlUp).Offset(2, 0).Select
                .Paste
            End With
            .parentWindow.clipboardData.clearData "Text"
        End If
    End With
End Sub

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

Voici le rendu de ton code

Je trouve que c'est très bien
Nom : Capture.PNG
Affichages : 175
Taille : 23,8 Ko

**patricktoulon** · 27/07/2015, 10h01

Bonjour sebphyto
ouis mais

tu n'a pas 15 16 17 dans les lignes cheval et places
tu n'a toujours pas l'arrivée pas l'arrivée
c'est vraiment a se taper la tete conre les murs
essaie celui la
j'ai netoyé le code html de la table syntheze (plus le lien )
j'ai construit la ligne places et cheval cynamiquement
pour le texte de debut j'ai aussi modifié je coupe le html pour le renvoyer dans le body pour en récupérer le innertext
on coupe par "<TABLE" en majuscule

envoie la capture pour voir coment ca rend chez toi

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
Sub testesimple57()
    Dim z As Long, pluss As Long, dicoseb, dicopat, mesTRREF, listPRnst, MESTH, docTemp
    listPRnst = Array("Bilto :", "Agence TIP :", "Top Entraineurs : ", "Stato Turf : ", "Paris Turf : ")
    Sheets(1).Cells.ClearContents
    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 = 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 = docTemp.body.innertext
        Set docTemp = Nothing
        .Quit
    End With
 
    With CreateObject("htmlfile")
        .body.innerhtml = textedebut & codetable & "<br>" & codesynth
        If .parentWindow.clipboardData.setData("Text", .body.innerhtml) Then
            Application.ScreenUpdating = False
            With Sheets(1)
                .Activate
                '.Cells.Clear
                Cells(Rows.Count, 1).End(xlUp).Offset(2, 0).Select
                .Paste
            End With
            .parentWindow.clipboardData.clearData "Text"
        End If
    End With
End Sub

**Sebphyto** · 27/07/2015, 12h10

Bon là c'est bon j'ai tout

Nom : Capture.PNG
Affichages : 268
Taille : 35,1 Ko

il reste à la ligne 11, le texte mais plus le lien, c pas si grave

**patricktoulon** · 27/07/2015, 12h30

bon jevais voir pour la ligne texte mais tu a 2 fois la ligne places c'est pas normal

c'est le dernier que tu a éssayé ?? celui de cematin???,

**Sebphyto** · 27/07/2015, 12h41

oui c ca le 57, Est-ce qu'en soi c'est gênant???

**patricktoulon** · 27/07/2015, 12h44

hahaha !!!!!! un peu que c'est genant
etant donné que je tri ,clase, met en ordre dans le faux doc en memoire :quelle ligne je vais prendre hahahahahaha t'es trop drole
allez pour la peine LOL!!!

je viens de regarder mon code
et je ne vois aucune raison pour cette répétition

efface bien le sheet avant de lancer la sub 57

la 58 arrive je m'occupe des données puisque tu a tout le debut maintenant comme moi

**Sebphyto** · 27/07/2015, 12h58

C vrai mais j'ai encore du mal, avec le faux html, jai cette vision mais pas pour tout, ça va venir, mais depuis le temps qu'on passe là-dessus, je commence à comprendre

j'allais te dire que sinon on le supprime la ligne "place et le texte" chez moi la ligne 10 et 11, une fois l'import terminé, mais non c pas possible car il est avant le "paste sheet1" dans le faux doc!!!!

**patricktoulon** · 27/07/2015, 13h10

tu te rends bien compte que dans mon code la ligne n'est pas répétée

Code :

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

codesynth = codesynth & ligneplace & mesTR(i).outerhtml & "<TR></TR>" & lignecheval

on place dans codesynth la ligne place que je construit ,la ligne synthèse que je récupère,la ligne cheval que j'ai construite

alors ou va chercher les 2 eme ton ordi hein!!!!

ta vraiment des réaction bizare dans ton system
essaie ccette ligne a la place

Code :

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

codesynth = ligneplace & mesTR(i).outerhtml & "<TR></TR>" & lignecheval

si c'est bon on a un soucis l'interpreteur vba interprete chaque "&" comme iteration

c'est du coton chez toi hahahah!

**Sebphyto** · 27/07/2015, 13h15

regarde comme c beau
Nom : Capture.PNG
Affichages : 198
Taille : 27,2 Ko

**patricktoulon** · 27/07/2015, 13h17

Alelouia !!Alelouia! laelouia..alelouia.......

c'est bien ca alors tu a changer la ligne ??

bon maintenant on a le meme avec le meme code :j'ai bien bossé moi pfffffff
allez 58

on amaintenant le nombre de fois cité
on va avancer par etapes comme ca je me retrouve pas avec des diférences imcompréhensibles OK
58

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
Sub testesimple58()
    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 = docTemp.body.innertext
        Set docTemp = Nothing
        .Quit
    End With
 
    With CreateObject("htmlfile")
        .body.innerhtml = textedebut & 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(Rows.Count, 1).End(xlUp).Offset(2, 0).Select
                .Paste
            End With
            .parentWindow.clipboardData.clearData "Text"
        End If
    End With
End Sub

allez on y va maintenant renvoie la capture

**Sebphyto** · 27/07/2015, 13h36

yes sir

it's good

Nom : Capture.PNG
Affichages : 151
Taille : 28,9 Ko

**patricktoulon** · 27/07/2015, 13h48

Ok
laisse moi 15 ou 20 minutes je fini le split debut

donne moi la ligne entiere que tu obtiens jusque au bout
on vois pas la fin dans la capture

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

voici

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

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

Macros et VBA Excel

Discussions similaires

Partager

Partager