XL 2010 résolus

n_turf · Hier à 06:46

bonjour ,
voila , j'ai fait appel à une AI ( Claude) afin de m'aider à créer se fichier concernant les courses de chevaux mais , buggs récurant , en fait dés qu'il touche à quelques choses cela met en vrille autres choses et du coup j'ai perd des mois d'archivages , bref du temps etc etc ....
dernierement je me suis appercus que l'archivage ne se faisait pas correctement concernant les pages " réunion " , a priori seul la page " Réunion 3 " se fait correctement , je dit bien à priori ...malheuresement je ne peut pas télécharger ici le fichier ( trop volumineux ) , donc je vous copie le code VBA qui peut étre sera vous renseigner sur l'erreur ....

VB:

' ================================================================
' MODULE : ModuleArchivage v4 - Archivage COMPLET
' ================================================================
Sub SauvegarderFichier()
    ThisWorkbook.Save
End Sub
Sub ArchiverReunion1()
    Call ArchiverReunion("Réunion1", "Réunion 1")
End Sub
Sub ArchiverReunion2()
    Call ArchiverReunion("Réunion2", "Réunion 2")
End Sub
Sub ArchiverReunion3()
    Call ArchiverReunion("Réunion3", "Réunion 3")
End Sub
Sub ReinitReunion1()
    Call ReinitReunion("Réunion1")
End Sub
Sub ReinitReunion2()
    Call ReinitReunion("Réunion2")
End Sub
Sub ReinitReunion3()
    Call ReinitReunion("Réunion3")
End Sub
Sub ArchiverReunion(nomFeuille As String, labelReunion As String)
    Dim wsR As Worksheet, wsH As Worksheet
    Dim nextRow As Long, synRow As Long
    Dim courseRow As Long, ptRow As Long
    Dim nbArchives As Integer, i As Integer
    On Error GoTo ErrHandler
    ThisWorkbook.Save
    Set wsR = ThisWorkbook.Sheets(nomFeuille)
    Set wsH = ThisWorkbook.Sheets("Historique")
    wsH.Unprotect Password:=""
    nextRow = wsH.Cells(wsH.Rows.Count, "A").End(xlUp).Row + 1
    If nextRow < 4 Then nextRow = 4
    nbArchives = 0
    For synRow = 6 To 42 Step 4
        courseRow = synRow - 2
        ptRow = synRow - 1
        If wsR.Cells(courseRow, 3).Value = "" Then GoTo NextCourse
        wsH.Cells(nextRow, 1).Value = wsR.Cells(synRow, 11).Value
        wsH.Cells(nextRow, 2).Value = wsR.Cells(1, 4).Value
        wsH.Cells(nextRow, 3).Value = wsR.Cells(1, 6).Value
        wsH.Cells(nextRow, 4).Value = labelReunion
        wsH.Cells(nextRow, 5).Value = wsR.Cells(courseRow - 1, 1).Value
        wsH.Cells(nextRow, 6).Value = wsR.Cells(courseRow, 3).Value
        wsH.Cells(nextRow, 7).Value = wsR.Cells(courseRow, 4).Value
        wsH.Cells(nextRow, 8).Value = wsR.Cells(courseRow, 15).Value
        wsH.Cells(nextRow, 9).Value = wsR.Cells(courseRow, 16).Value
        wsH.Cells(nextRow, 10).Value = wsR.Cells(courseRow, 17).Value
        wsH.Cells(nextRow, 11).Value = wsR.Cells(courseRow, 18).Value
        wsH.Cells(nextRow, 12).Value = wsR.Cells(ptRow, 15).Value
        wsH.Cells(nextRow, 13).Value = wsR.Cells(ptRow, 17).Value
        wsH.Cells(nextRow, 14).Value = wsR.Cells(synRow, 15).Value
        wsH.Cells(nextRow, 15).Value = wsR.Cells(synRow, 16).Value
        wsH.Cells(nextRow, 16).Value = wsR.Cells(synRow, 17).Value
        wsH.Cells(nextRow, 17).Value = wsR.Cells(synRow, 21).Value
        wsH.Cells(nextRow, 18).Value = wsR.Cells(synRow, 22).Value
        wsH.Cells(nextRow, 19).Value = wsR.Cells(synRow, 23).Value
        wsH.Cells(nextRow, 20).Value = wsR.Cells(synRow, 24).Value
        wsH.Cells(nextRow, 21).Value = wsR.Cells(synRow, 26).Value
        wsH.Cells(nextRow, 22).Value = wsR.Cells(synRow, 27).Value
        wsH.Cells(nextRow, 23).Value = wsR.Cells(synRow, 28).Value
        wsH.Cells(nextRow, 24).Value = wsR.Cells(synRow, 29).Value
        wsH.Cells(nextRow, 25).Value = wsR.Cells(synRow, 30).Value
        wsH.Cells(nextRow, 26).Value = wsR.Cells(synRow, 31).Value
        wsH.Cells(nextRow, 27).Value = wsR.Cells(synRow, 32).Value
        wsH.Cells(nextRow, 28).Value = wsR.Cells(synRow, 33).Value
        wsH.Cells(nextRow, 29).Value = wsR.Cells(synRow, 34).Value
        wsH.Cells(nextRow, 30).Value = wsR.Cells(synRow, 35).Value
        wsH.Cells(nextRow, 31).Value = wsR.Cells(synRow, 36).Value
        wsH.Cells(nextRow, 32).Value = wsR.Cells(synRow, 37).Value
        wsH.Cells(nextRow, 33).Value = wsR.Cells(synRow, 38).Value
        wsH.Cells(nextRow, 34).Value = wsR.Cells(ptRow, 19).Value
        wsH.Cells(nextRow, 35).Value = wsR.Cells(ptRow, 22).Value
        wsH.Cells(nextRow, 36).Value = wsR.Cells(synRow, 19).Value
        wsH.Cells(nextRow, 37).Value = wsR.Cells(synRow, 22).Value
        For i = 1 To 8
            wsH.Cells(nextRow, 37 + i).Value = wsR.Cells(courseRow, 2 + i).Value
        Next i
        For i = 1 To 8
            wsH.Cells(nextRow, 45 + i).Value = wsR.Cells(ptRow, 2 + i).Value
        Next i
        For i = 1 To 8
            wsH.Cells(nextRow, 53 + i).Value = wsR.Cells(synRow, 2 + i).Value
        Next i
        nbArchives = nbArchives + 1
        nextRow = nextRow + 1
NextCourse:
    Next synRow
    wsH.Protect Password:=""
    If nbArchives > 0 Then
        MsgBox nbArchives & " course(s) archivee(s) !", vbInformation, "Archivage OK"
    Else
        MsgBox "Aucune donnee a archiver.", vbExclamation, "Rien a archiver"
    End If
    Exit Sub
ErrHandler:
    wsH.Protect Password:=""
    MsgBox "Erreur : " & Err.Description, vbCritical, "Erreur archivage"
End Sub
Sub ReinitReunion(nomFeuille As String)
    If MsgBox("Effacer toutes les saisies de " & nomFeuille & " ?", vbYesNo + vbQuestion, "Confirmer") = vbNo Then Exit Sub
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets(nomFeuille)
    ws.Unprotect Password:=""
    Dim r As Long
    For r = 4 To 40 Step 4
        ws.Range(ws.Cells(r, 3), ws.Cells(r, 10)).ClearContents
        ws.Range(ws.Cells(r + 1, 3), ws.Cells(r + 1, 10)).ClearContents
        ws.Cells(r, 15).ClearContents
        ws.Cells(r, 16).ClearContents
        ws.Cells(r, 17).ClearContents
        ws.Cells(r, 18).ClearContents
        ws.Cells(r + 1, 15).ClearContents
        ws.Cells(r + 1, 16).ClearContents
        ws.Cells(r + 1, 19).ClearContents
        ws.Cells(r + 2, 19).ClearContents
    Next r
    Call RestaurerSyntheses(ws)
    ws.Protect Password:=""
    MsgBox nomFeuille & " reinitialisee !", vbInformation, "OK"
End Sub
Sub RestaurerSyntheses(ws As Worksheet)
    Dim syn As Long, col As Long, idx As Integer
    Dim zt As Long, pt As Long
    For syn = 6 To 42 Step 4
        zt = syn - 2: pt = syn - 1
        For col = 3 To 10
            idx = col - 2
            ws.Cells(syn, col).Formula = _
                "=IFERROR(IF(ISNUMBER(MATCH(LARGE(AT" & syn & ":BJ" & syn & "," & idx & "),AT" & syn & ":BA" & syn & ",0))," & _
                "INDEX(C" & zt & ":J" & zt & ",MATCH(LARGE(AT" & syn & ":BJ" & syn & "," & idx & "),AT" & syn & ":BA" & syn & ",0))," & _
                "INDEX(C" & pt & ":J" & pt & ",MATCH(LARGE(AT" & syn & ":BJ" & syn & "," & idx & "),BB" & syn & ":BI" & syn & ",0))),"""")"
        Next col
        ws.Cells(zt, 12).Formula = "=IF(C" & syn & "="""","""",C" & syn & ")"
        ws.Cells(zt, 13).Formula = "=IF(D" & syn & "="""","""",D" & syn & ")"
    Next syn
End Sub
Sub ArchiverQuinte()
    Dim wsQ As Worksheet, wsAQ As Worksheet
    Dim nextRow As Long, j As Integer
    On Error GoTo ErrHandler
    ThisWorkbook.Save
    Set wsQ = ThisWorkbook.Sheets("Quinté+")
    Set wsAQ = ThisWorkbook.Sheets("Archive Quinté")
    nextRow = wsAQ.Cells(wsAQ.Rows.Count, "A").End(xlUp).Row + 1
    If nextRow < 2 Then nextRow = 2
    If wsQ.Cells(2, 2).Value = "" Then
        MsgBox "Aucun prono saisi dans Quinté+", vbExclamation, "Rien a archiver"
        Exit Sub
    End If
    For j = 1 To 8
        wsAQ.Cells(nextRow, j).Value = wsQ.Cells(2, 1 + j).Value
    Next j
    For j = 1 To 8
        wsAQ.Cells(nextRow, 8 + j).Value = wsQ.Cells(3, 1 + j).Value
    Next j
    For j = 1 To 8
        wsAQ.Cells(nextRow, 16 + j).Value = wsQ.Cells(4, 1 + j).Value
    Next j
    For j = 1 To 8
        wsAQ.Cells(nextRow, 24 + j).Value = wsQ.Cells(5, 1 + j).Value
    Next j
    wsAQ.Cells(nextRow, 33).Value = wsQ.Cells(8, 4).Value
    wsAQ.Cells(nextRow, 34).Value = wsQ.Cells(8, 5).Value
    wsAQ.Cells(nextRow, 35).Value = wsQ.Cells(8, 6).Value
    wsAQ.Cells(nextRow, 36).Value = wsQ.Cells(8, 7).Value
    wsAQ.Cells(nextRow, 37).Value = wsQ.Cells(8, 8).Value
    MsgBox "Quinté+ archivé ! Ligne " & nextRow & ".", vbInformation, "Archivage OK"
    Exit Sub
ErrHandler:
    MsgBox "Erreur : " & Err.Description, vbCritical, "Erreur archivage"
End Sub
Sub GenererTicketQuinte()
    Dim wsQ As Worksheet
    Set wsQ = ThisWorkbook.Sheets("Quinté+")
    wsQ.Calculate
    MsgBox "Ticket généré !", vbInformation, "Ticket Quinté+"
End Sub

merci d'avance

n_turf · Hier à 06:50

n_turf · Hier à 06:51

je met des copies d'écran que vous voyez les erreurs , par exemple mémes les dates ne sont plus archiver et j'en passe

jcf6464 · Hier à 10:23

n_turf à dit:
je met des copies d'écran que vous voyez les erreurs , par exemple mémes les dates ne sont plus archiver et j'en passe

Regarde la pièce jointe 1228830

Bonjour n_turf et le forum,

Avec un fichier ce serais mieux je pense,

bonne continuation jcf6464

Nain porte quoi · Hier à 10:56

Hello,

sérieux ?
Vous pensez qu'on va pouvoir lire le code (de m***) généré par une IA (Idiotie Avérée) et comprendre ce qui se passe avec des images ?
Placez donc le fichier sur un site comme https://www.swisstransfer.com/fr et coller le lien ici, ça sera déjà une grand avancée

n_turf · Hier à 11:12

bonjour , désolé je n'arriver pas a transférer le fichier et ne savais ou est comment faire ( je sais je suis plus que idiot )

https://www.swisstransfer.com/d/e87fff11-52b8-48ec-8238-0bb19394486c

Nain porte quoi · Hier à 11:17

OK, maintenant qu'on a le fichier il ne vous reste plus qu'a nous dire ce qu'il faut faire avec 😉
Parce que le code de Claude... heum, comment dire... il est incompréhensible (...du moins pour moi)

n_turf · Hier à 11:43

imaginez pour moi ........
Normalement , on va dire que chaque page de réunions doit s'archiver lorsque je clique sur " archive " que se soit , date , discipline , nbr de course , hippodrome mais également les pronos ainsi que la synthese et les rapports et arrivées , cela afin ensuite de nourir les stats

n_turf · Hier à 12:11

je vais tenter d'étre plus clair du moins dans se que je recherche a faire ( sa fait 4 mois que je bosse la dessus et se satané AI claude m'a deja perdu énormément d'archivage sans commpter les fausses stats etc ) ...
donc , j'insére concernant les pages réunions deux pronostiques de la presse , une " synthese " se crée automatiquement ( C4 J6 pour la premiere course ), une sélection de 2 chevaux L et M se crée également automatiquement , ensuite j'insére les arrivée de O4 a R4 et les rapports de chaque course de O5 a S6 , de B51 a G63 les tableau du " course par course " se générant seul au fur et a mesure ....et donc il faut les archiver afin d'obtenir les stats nécéssaire a chaque type de jeux et " nourir " également les autres pages dédier tels que " tickets réunion" qui se genere toute seule , mais surtout et avant tout la page " stats pronos " qui elle aussi normalement doit à chaque archivage me donnée les stats ecact pour les differents type de jeux .
voila , si vous avez d'autres questions ?

Nain porte quoi · Hier à 16:44

Désolé, mais là vous dites ce que vous vous faites, mais ça ne dit pas ce qu'il faut faire

n_turf · Hier à 18:01

aie aieeee , en fait je souhaiterai que se soit archiver de la bonne maniére afin de sauvegarder les données correctement et ne plus les perdres et pouvoir les utilisées par la suite pour les stats

Nain porte quoi · Hier à 19:14

OK, mais c'est quoi "archiver de la bonne manière" ? Quelles données doit allée où ?

n_turf · Hier à 19:46

les données doivent allez dans la page " historique " ,comme dans les dernieres lignes de 576 à 584 sauf qu'il manque les dates qui devrait étre en colonne A

Nain porte quoi · Hier à 22:58

C'est un dialogue de SOURDS !
Bon, dernière tentative :
Dans la feuille Historique, dans la colonne Date, la données provient de quelle feuille et de quelle cellule ?
idem pour : Hippodrome
idem pour : Réunion
idem pour : N° Course
idem pour : Prono 1
idem pour : Prono 2
idem pour : 1er
idem pour : 2ème
idem pour : 3ème
idem pour : 4ème
idem pour : Rpt Gagnant
idem pour : Rpt Couplé G
idem pour : Rpt Placé 1
idem pour : Rpt Placé 2
idem pour : Rpt Placé 3
idem pour : Gagnant Pronos
idem pour : "Placé Pronos"
idem pour : "Rendement (€)"
idem pour : "Écart Course"
idem pour : "G 1er Zeturf"
idem pour : "G 2e Zeturf"
idem pour : "G 3e Zeturf"
idem pour : "P 1er Zeturf"
idem pour : "P 2e Zeturf"
idem pour : "P 3e Zeturf"
idem pour : "G 1er P.Turf"
idem pour : "G 2e P.Turf"
idem pour : "G 3e P.Turf"
idem pour : "P 1er P.Turf"
idem pour : "P 2e P.Turf"
idem pour : "P 3e P.Turf"
idem pour : "Couplé Gagnant"
idem pour : "Trio ZeTurf"
idem pour : "Trio P.Turf"
idem pour : "Multi ZeTurf"
idem pour : "Multi P.Turf"
idem pour : ZT1
idem pour : ZT2
idem pour : ZT3
idem pour : ZT4
idem pour : ZT5
idem pour : ZT6
idem pour : ZT7
idem pour : ZT8
idem pour : PT1
idem pour : PT2
idem pour : PT3
idem pour : PT4
idem pour : PT5
idem pour : PT6
idem pour : PT7
idem pour : PT8
idem pour : SYN1
idem pour : SYN2
idem pour : SYN3
idem pour : SYN4
idem pour : SYN5
idem pour : SYN6
idem pour : SYN7
idem pour : SYN8
idem pour : Base1 Auto
idem pour : Base2 Auto
idem pour : "PT1 (1er cité)"
idem pour : "PT2 (2e cité)"
idem pour : "Conv. 1er"
idem pour : "Couplé ZT"
idem pour : "Couplé PT"

Comprenez que vous vous travaillez avec depuis 4 mois et que nous on n'est pas dans votre tête, je ne peux en aucun cas deviner quelle données va dans quelle cellule et il est hors de question que j'essaye de lire le code (de m***) produit par l'Idiotie Avérée

n_turf · Aujourd'hui à 06:26

merci à vous
bonne journée et désolé du dérangement

XL 2010 résolus

n_turf

XLDnaute Nouveau

n_turf

XLDnaute Nouveau

n_turf

XLDnaute Nouveau

jcf6464

XLDnaute Impliqué

Nain porte quoi

XLDnaute Occasionnel

n_turf

XLDnaute Nouveau

Nain porte quoi

XLDnaute Occasionnel

n_turf

XLDnaute Nouveau

n_turf

XLDnaute Nouveau

Nain porte quoi

XLDnaute Occasionnel

n_turf

XLDnaute Nouveau

Nain porte quoi

XLDnaute Occasionnel

n_turf

XLDnaute Nouveau

Nain porte quoi

XLDnaute Occasionnel

n_turf

XLDnaute Nouveau

Discussions similaires

XL 2010 résolus

XLDnaute Nouveau

XLDnaute Nouveau

XLDnaute Nouveau

XLDnaute Impliqué

XLDnaute Occasionnel

XLDnaute Nouveau

XLDnaute Occasionnel

XLDnaute Nouveau

XLDnaute Nouveau

XLDnaute Occasionnel

XLDnaute Nouveau

XLDnaute Occasionnel

XLDnaute Nouveau

XLDnaute Occasionnel

XLDnaute Nouveau

Discussions similaires

Privacy & Transparency

Privacy & Transparency