XL 2019 Problème fichier à l'enregistrement

[Ferbank]

Bonjour; j'ai un sacré prob avec mon fich statitique Excel.
2 sociètaires du forum pour lequels je renouvelle mes remerciements, ils se reconnaitront .
Quand je modifie une valeur dans le tableau feuille "Tirage Daté Euromillon"il recalcule tous pendant 10 ' es ce normal?
Necessité de mettre à jour les tirages après chaque sortie
Je précise que je suis bien sous Excel 2019 et un destop 8 GO de ram I3: il en est de même sur mon portable Predator I 7 ACER 16 GO de ram .
Dans ce fichier les feuilles sont liées pour certaines .
il y a une macro qui fontionne très bien dans la feuille Tirage Datés Euromillon; les autres feuilles avec des formules.
Excel me précise bien certaines anomalies, " boucle" je n'arrive pas à m'en sortir.
Merci si vous voyez mieux que moi.
Ferbank

je joints un lien j'espère qu'il fonctionnera

EUROMILLON_BUZ.xlsm

1 file sent via WeTransfer, the simplest way to send your files around the world

we.tl

 

[fanch55]

Bonjour,
Je pense que c'est quand vous modifiez une valeur de la plage [T11:X11]
que cela prend énormément de temps,
car c'est ce qui provoque un traitement dans le Worksheet_Change de la feuille "Tirages Datés Euromillon"

Pourquoi ne pas un mettre un
Application.EnableEvents = False après le Application.ScreenUpdating = False
et un Application.EnableEvents = true en fin de sub ?

 

[Ferbank]

Bonjour et merci de votre aide, je ne pige rien en VB j'ai ecris dans la macro vos formules, mais je ne sais pas placer la dernière modif, des trois modifs en italiques, es ce bon .
Ca parait fonctionner et je ne sais pas pourquoi!
De plus dans la fenêtre "Suite sorties plusieurs fois" c'est le grand bordel !!!
quand j'incrémente les résultats des sortis des tirages colonne B les modifs ne s'effectuent pas dans les autres colonnes!!!!
Voici une copie de la modif macro ci bas

Sub macrojob752dec()
Dim Recherche As Range, P As Range, Dates As Range, c As Range, Q As Range, R As Range
Set Recherche = [T11:X11]
Set P = [E:I]
Set Recherche = [Y11:Z11]
Set P = [J:K]
Set Dates = [D]
If Intersect(Target, Recherche) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.EnableEvents = True
On Error Resume Next 'si aucune SpecialCell
'Recherche.Offset(1).Resize(Rows.Count - Recherche.Row, Recherche.Columns.Count + 1).Delete xlUp 'RAZ
Recherche.Offset(1).Resize(Rows.Count - Recherche.Row, Recherche.Columns.Count + 2).ClearContents 'RAZ
For Each c In Recherche
If c <> "" Then
P.Replace c, "#N/A", xlWhole
Set Q = Nothing
Set Q = P.SpecialCells(xlCellTypeConstants, 16)
If Q Is Nothing Then Exit Sub
Q = c
Set Q = Intersect(Q.EntireRow, P)
If R Is Nothing Then Set R = Q Else Set R = Intersect(Q, R)
If R Is Nothing Then Exit Sub
End If
Next
'---résultat---
R.Copy Recherche(2, 1)
Intersect(R.EntireRow, Dates).Copy Recherche(2, Recherche.Columns.Count + 1)
End Sub

 

[fanch55]

Le code cité est celui qui est dans la feuille "Tirages Datés Euromillon".
Ce n'est pas un code qui peut fonctionner dans un module.
Je pense qu'il peut être "optimisé".
Je vais analyser le mécanisme et je vous tiens au courant s'il y a mieux ...

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Recherche1 As Range, Recherche2 As Range, Recherche As Range, P1 As Range, P2 As Range, P As Range
Dim Dates As Range, c As Range, Q As Range, R As Range
Set Recherche1 = [T11:X11]
Set Recherche2 = [Y11:Z11]
Set Recherche = Union(Recherche1, Recherche2)
If Intersect(Target, Recherche) Is Nothing Then Exit Sub
Set P1 = [E:I]
Set P2 = [J:K]
Set P = Union(P1, P2)
Set Dates = [D:D]
Application.ScreenUpdating = False
Application.EnableEvents = False
    On Error Resume Next 'si aucune SpecialCell
    'Recherche.Offset(1).Resize(Rows.Count - Recherche.Row, Recherche.Columns.Count + 1).Delete xlUp 'RAZ
    Recherche.Offset(1).Resize(Rows.Count - Recherche.Row, Recherche.Columns.Count + 1).ClearContents 'RAZ
    For Each c In Recherche1
        If c <> "" Then
            P1.Replace c, "#N/A", xlWhole
            Set Q = Nothing
            Set Q = P1.SpecialCells(xlCellTypeConstants, 16)
            If Q Is Nothing Then GoTo Exit_Sub
            Q = c
            Set Q = Intersect(Q.EntireRow, P)
            If R Is Nothing Then Set R = Q Else Set R = Intersect(Q, R)
            If R Is Nothing Then GoTo Exit_Sub
        End If
    Next
    For Each c In Recherche2
        If c <> "" Then
            P2.Replace c, "#N/A", xlWhole
            Set Q = Nothing
            Set Q = P2.SpecialCells(xlCellTypeConstants, 16)
            If Q Is Nothing Then GoTo Exit_Sub
            Q = c
            Set Q = Intersect(Q.EntireRow, P)
            If R Is Nothing Then Set R = Q Else Set R = Intersect(Q, R)
            If R Is Nothing Then GoTo Exit_Sub
        End If
    Next
    '---résultat---
    R.Copy Recherche(2, 1)
    Intersect(R.EntireRow, Dates).Copy Recherche(2, Recherche.Columns.Count + 1)

Exit_Sub: Application.EnableEvents = True
End Sub

 

[Ferbank]

Bonjour un peu tard mais je suis très occupé avec les petits enfants;
avez vous apporter une modif à mon fichier, je ne pense pas qu'il s'agisse de la macro mais des formules imbriquées dans la feuille après "tirage datés Euromillon" telles que celle "suites plusieurs fois"
ou dois je valider l'exemple de l'édition de la macro ci dessus?
merci

 

[fanch55]

Bonjour,
Je ne sais pas trop ce que vous voulez faire dans vos formules .
Le code précédemment joint fonctionne correctement.

ci-joint le classeur fourni corrigé, j'ai abandonné les recherches car n'apportant pas plus ...

EUROMILLON_BUZ.xlsm

1 file sent via WeTransfer, the simplest way to send your files around the world

we.tl

 

[Ferbank]

Bonjour,
Je ne sais pas trop ce que vous voulez faire dans vos formules .
Le code précédemment joint fonctionne correctement.

ci-joint le classeur fourni corrigé, j'ai abandonné les recherches car n'apportant pas plus ...

EUROMILLON_BUZ.xlsm

1 file sent via WeTransfer, the simplest way to send your files around the world

we.tl

Bonjour je suis désolé vraiment de ne pas avoir répondu suffisamment tôt le lien est expiré auriez vous la patience de me le réactiver ?
je vous en remercie grandement
Ferbank

 

[fanch55]

En espèrant que c'est le bon :

EUROMILLON_BUZ.xlsm

1 file sent via WeTransfer, the simplest way to send your files around the world

we.tl

 

[Ferbank]

Merci encore; je réactive le fich, mise à jour des tirages , et je refais mes stats.
merci