Surveillance des plaques de jeu de loto

Bonjour à tous, je préside une association vouée à la recherche médicale et la pandémie que nous connaissons tous a "contrarié" l'ensemble des projets prévus.

Dans le fichier joint, c'est un petit morceau de ce qui constitue notre proposition de "Loto à la Maison"

Si vous acceptez de me glisser votre avis sur le choix pour surveiller si le numéro tiré fait parti d'une des grilles d'un participant c'est vraiment sympa.

Merci de votre indulgencie, je suis à peine utilisateur d'excel

Bien sûr le fichier complet va de l'inscription, choix de plaque, grille des gagnants...

D'avance merci

Sébastien

Salut,

Ton fichier semble une vraie usine à gaz et ça fout un peu la trouille d'y mettre un doigt, de peur d'être emporter par un engrenage.

Qu'entends-tu par : "choix pour surveiller si le numéro tiré fait parti d'une des grilles d'un participant" ?

Où se trouve le numéro tiré ? Quelles grilles doivent être contrôlées ?

Donne tes explications en faisant référence aux objets Excel (cellule, plage, feuille, UserForm, etc.), en utilisant leur nom, et place quelques données (pas besoin de 10'000 lignes) sur tes feuilles afin que ce soit plus compréhensible.

A te relire.

Bonsoir, voici donc une version je l'espère plus compréhensible.

Les explications sont dans le fichier.

Je me suis permis d'adresser un message en mode MP pour un extrait de nos séances "lotos"

Je suis à disposition

Encore merci du regard posé sur mes problématiques

Bien cordialement

Sébastien

Salut,

J'ai jeté un coup d'œil à ta vidéo et effectivement que ça donne une petite idée de ce que tu réalises.

En ce qui concerne ton fichier Excel, tu ne devrais pas donner d'explication directement dans ton fichier, mais sur ton fil, ce qui facilite la consultation de l'historique de la discussion.

Ces explications dans ton fichier me semblent moyennement claires. Je n'ai par exemple pas compris comment venait s'inscrire le nouveau numéro tiré dans ton UserForm17.

Ton problème semble être la boucle de la macro CommandButton20_Click du UserForm17. Au premier coup d'œil, je ne vois pas de proposition d'amélioration, tout semble assez logique. Peut-être que quelqu'un d'un peu plus doué pourra t'aider malgré tout, éventuellement en passant par un ''Tableau'' ????

Je ne peux que te conseiller alors d'indiquer ce fil comme ''Résolu'' et de repartir sur de nouvelles bases.

N'indique par exemple pas : "veuillez me glisser votre avis sur le choix pour surveiller si le numéro tiré fait partie d'une des grilles'', mais plutôt : " dans la macro xy placée dans le code du UserFormAB, j'ai une boucle qui ralentit terriblement la procédure dès que le nombre de grille dans la colonne AM de la feuille ''Genmanu'' dépasse 2 à 3000. Voici comment est déclenché cette boucle : ……………………… Pensez-vous que de passer par un Tableau serait la solution ? Mais je ne sais pas réaliser cela et j'aurais besoin de votre aide ".

Désolé de ne pas avoir pu t'aider mieux

Salut,

Merci pour tout tes conseils

Je vais indiquer ce fil comme résolu

Au plaisir

Sébastien

Bonjour,

un essai :

Sub test()
    Dim n As Long, pl As Range, pl2 As Range, c As Range
    Dim nbg As Long
    Dim adr1 As String, t
    n = 18
    With Sheets("Genmanu")
        Set pl = .[V:AJ]
        t = .[T1].Resize(.Cells(Rows.Count, "V").End(xlUp).Row).Value ' lecture compteurs en 1 fois !
        Set pl2 = [A1] ' pour éviter 7000 tests =nothing
        Set c = pl.Find(n, LookIn:=xlValues, lookat:=xlWhole)
        If Not c Is Nothing Then
            adr1 = c.Address
            Do
                t(c.Row, 1) = t(c.Row, 1) + 1
                If t(c.Row, 1) = 15 Then Set pl2 = Union(pl2, c)
                Set c = Cells.Find(n, LookIn:=xlValues, lookat:=xlWhole, After:=c)
            Loop While Not c Is Nothing And c.Address  adr1
        End If
        ' coller compteurs
        .[T1].Resize(.Cells(Rows.Count, "V").End(xlUp).Row).Value = t
        ' gagnants
        If pl2.Count  1 Then
            MsgBox "Il y a " & pl2.Count & " gagnant(s)"
            For Each c In pl2
                If c.Address  <> "$A$1" Then
                    MsgBox "1 gagnant en ligne " & c.Row
                End If
            Next c
        End If
    End With
    Set c = Nothing: Set pl = Nothing: Set pl2 = Nothing
End Sub

Je ne me suis pas mis dans tes UserForm pour me simplifier la vie, je travaille juste sur la feuille.
Je travaille sur la plage entière pour le .Find plutôt que ligne par ligne.
Et je te ressors le résultat en 1 fois à la fin pour avoir une écriture unique sur la feuille.
Je pense que ça devrait être plus rapide, sans savoir de combien vu que je ne sais pas combien tu mettais pour cette feuille.
Chez moi (vieux PC) ça prend 1,2 s
eric

Bonjour Eric et merci beaucoup.

L'idée de la plage entière plutôt que ligne par ligne est bonne

Pour environ 7000 lignes + OBS studio et le streaming youtube réalisé avec le même PC if faut quasiment 2,5 secondes

Le fichier seul : 1,5 seconde

J'aimerai beaucoup essayer ta proposition mais je n'y parviens pas ??

find 1

J'ai dans cette ligne Loop.. retiré adr1. à la ligne If pl2.Count...j'ai ajouté > 1 Then...

find 2

Je suis sans doute dans la mauvaise direction et n'arrives pas à essayer ta proposition et donc d'en apprécier la différence

Tu as sans doute des éléments d'explications

Bien cordialement

Sébastien

un bug du site a fait sauter le test. Lire :

Loop While Not c Is Nothing And c.Address <> adr1

et

If c.Address <> "$A$1" Then

eric

suite...

J'ai fait un essai avec tableau en mémoire.
Je passe à 0.085 s, à voir...
J'ai mis l'annonce des résultats en commentaire. J'ai dû faire des dizaines de fois Enter pour pouvoir arrêter la machine infernale et enregistrer mon code

Sub test2()
    Dim n As Long
    Dim nbg As Long
    Dim datas, nblig As Long, lig, col, gagnant()
    Dim adr1 As String, t
    n = 18
    With Sheets("Genmanu")
        nblig = .Cells(Rows.Count, "V").End(xlUp).Row
        ReDim gagnant(1 To nblig)
        datas = .[V:AJ].Resize(nblig).Value ' jeux
        t = .[T1].Resize(.Cells(Rows.Count, "V").End(xlUp).Row).Value ' lecture compteurs en 1 fois !

        For lig = 2 To UBound(datas)
            For col = 1 To UBound(datas, 2)
                If datas(lig, col) = n Then
                    t(lig, 1) = t(lig, 1) + 1
                    If t(lig, 1) = 15 Then
                        nbg = nbg + 1
                        gagnant(nbg) = lig
                    End If
                End If
            Next col
        Next lig
        ' coller compteurs
        .[T1].Resize(.Cells(Rows.Count, "V").End(xlUp).Row).Value = t
        If nbg > 0 Then
            MsgBox "Il y a " & nbg & " gagnant(s)"
            For lig = 1 To nbg
                'MsgBox "1 gagnant en ligne " & gagnant(lig)
            Next lig
        End If
    End With
End Sub

eric

Bonjour Eric,

Et merci beaucoup.

J'ai donc pu comparer tes deux propositions à la mienne.

La dernière proposition avec tableau en mémoire est vraiment plus rapide...super !!

Pour environ 7000 lignes ta première proposition et la mienne se valent en terme de durée d'exécution.

Si tu veux bien, je vais "adapter" ta deuxième proposition à mon fichier ??

Encore merci.

Rechercher des sujets similaires à "surveillance plaques jeu loto"