Microsoft 365 Gros problème de ralentissement au lancement d'un inputbox

[Usine à gaz]

Bonjour à toutes et à tous,
Je vous souhaite une belle journée

Je reviens vers nos ténors car j'ai un grave souci
Notre fichier de travail à toujours eu quelques ralentissement quand nous lançons un inputbox.
Mais depuis quelques temps, ça devient catastrophique.
Notamment au lancement de l'inputbox de recherche.
C'est devenu quasiment permanent ... 10 à 15 minutes d'attente à chaque lancement et ça toute la journée. Cela nous bloque dans notre travail.

A force de recherches, j'ai pensé qu'il s'agissait d'un souci de mémoire.
Selon mes lectures internet, pensant que la mémoire pourrait être libérée au fur et à mesure, j'ai ajouté à la fin des instructions Set ... :"Set ... = Nothing"
Malheureusement sans succès.

En fait, il semblerait que ce soit l'utilisation du Processeur qui soit en cause car
il passe pendant les blocages à plus de 47% d'utilisation alors que normalement il ne dépasse pas les 5%.

Je joins les éléments suivants :
- l'image info disque qui montre un espace libre de 327 Go,
- l'image info du système,
- l'image de l'état du processeur aux moments des bugs de ralentissement,
- le code de l'UserForm de recherche,

Sub Recherche_youky()
nom = InputBox("Cherche N° Client :" & Chr(10) & "      - Si pas de n°," & Chr(10) & "            - ou erreur n°," & Chr(10) & "                  Recommencez !", "Recherche")
If nom = "" Then
[a6].Select
Sheets("format-numero").Visible = False
Exit Sub
End If
Sheets("format-numero").Range("h3") = ""
  q = ActiveSheet.Index
  For q = q To ActiveSheet.Index + Sheets.Count - 1
    K = (q - 1) Mod (Sheets.Count) + 1
With Sheets(K).UsedRange
Application.ScreenUpdating = False
Range([g2], Cells(Rows.Count, "h").End(xlUp)).Activate
Set C = .Find(nom, LookAt:=xlPart)   'LookAt:=xlpart dans cellule - LookAt:=xlWhole) 'cellule entière
[a1].Activate
If Not C Is Nothing Then
firstAddress = C.Address
Do
On Error Resume Next
Sheets(K).Select
C.Activate
    Application.ScreenUpdating = True
    ActiveWindow.ScrollRow = Selection.Row
    If ActiveSheet.Name = "CopieAppels" Then
    Selection.RowHeight = 50
    End If

    If ActiveSheet.Name = "SuivisAppels" Then
    If Cells(ActiveCell.Row, 7) = C Or Cells(ActiveCell.Row, 8) = C Then

    Rows("6:6").Copy
    Cells(ActiveCell.Row, 1).Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Selection.RowHeight = 300

    End If
    End If
    Cells(ActiveCell.Row, 1).Select

If ActiveSheet.Name = "SuivisAppels" And Cells(ActiveCell.Row, 7) <> C And Cells(ActiveCell.Row, 8) <> C Then
rep = MsgBox(ActiveSheet.Name & " votre N° : " & C & " est absent ! Continuer la recherche ?", 4 + 32, "Sélection")
Sheets("format-numero").Visible = False
Else
rep = MsgBox(C & " : OK dans " & ActiveSheet.Name & Chr(10) & "" & Chr(10) & "Cellule - ligne :  " & C.Address & Chr(10) & Chr(10) & "" & "Continuer la recherche ?", 4 + 32, "Résultat")
End If
If rep = vbNo Then
Application.ScreenUpdating = False
Sheets("format-numero").Visible = False
Exit Sub
End If
Application.ScreenUpdating = False
Sheets("format-numero").Range [h3] = ""
Sheets("format-numero").Visible = False
If ActiveSheet.Name = "CopisAppels" Then
Sheets("SuivisAppels").Select
End If
Application.ScreenUpdating = True
Set C = .FindNext(C)
Loop While Not C Is Nothing And C.Address <> firstAddress
End If
End With
  Next q
MsgBox "Ben NON : y'a pas ou y'a plus !"
Application.ScreenUpdating = False
Sheets("format-numero").Visible = False
End Sub

Profane complet en la matière, je ne sais plus quoi faire.
Auriez-vous des idées, solutions ou pistes vers où me diriger ?

Avec mes remerciements,
Amicalement,
lionel,

 

[job75]

Bonsoir Lionel, le fil,

En décembre 2019 je t'ai fourni pour la recherche des numéros de téléphone une macro simple et rapide.

Je ne comprends pas (et je ne veux pas comprendre) comment tu es arrivé à créer une telle usine à gaz.

A+

 

[Staple1600]

Bonsoir job75

Je me suis fait la même remarque.

Re

=>Usine à gaz
[...]
Question au passage:
Tu utilises la procédure de job75 =>Sub Gerard() qui passe par un tableau pour la recherche?
Car celle-ci doit être plus rapide, non ?
[...]

NB: La macro était dans le 1er fichier exemple.

 

[fanch55]

@Usine à gaz ,
Les colonnes n° de téléphones sont en H:I dans l'onglet Rendez-vous, et en G:H dans les autres ...

 

[Usine à gaz]

Bonjour fanch55, Gérard, JM, le Forum,

Je suis désolé, je n'ai pas pu trouver une seul instant pour répondre aux derniers fils.
Je le fais dès que possible
fanch5
"Les colonnes n° de téléphones sont en H:I dans l'onglet Rendez-vous, et en G:H dans les autres ..."
Ce n'est pas un souci puisque le code cherche partout dans le fichier où peut être le n° cherché
lionel,

 

[fanch55]

fanch5
"Les colonnes n° de téléphones sont en H:I dans l'onglet Rendez-vous, et en G:H dans les autres ..."
Ce n'est pas un souci puisque le code cherche partout dans le fichier où peut être le n° cherché
lionel,

Justement, chercher là où doit se trouver théoriquement le n° fait gagner beaucoup de temps, surtout quand on parcourt plusieurs onglets de milliers de lignes .
D'autant plus que la recherche se faisant avec Xlpart, le traitement "annexe" se fait sur ce qu'il a trouvé.

 

[Usine à gaz]

Re-bonjour fanch55,

J'avoue que je ne comprends (mais mon niveau vba est bas lol)
Ne faut-il pas qu'il trouve d'abord le N° (dans l'ordre de la recherche, c'est à dire l'onglet actif d'abord "SuivisAppels") là où qu'il soit puisque le N° peut-être partout dans les onglets du fichier ?
et souvent, et c'est normal suivant les traitements, le N° peut être au moins dans 2 onglets.
lionel,

 

[Staple1600]

Bonjour le fil

=>Usine à gaz
Tu n'as pas répondu à la question que je posais?
Celle issue du post que je cite dans le message#47
(Sauf erreur de ma part)

 

[fanch55]

Re-bonjour fanch55,

J'avoue que je ne comprends (mais mon niveau vba est bas lol)
Ne faut-il pas qu'il trouve d'abord le N° (dans l'ordre de la recherche, c'est à dire l'onglet actif d'abord "SuivisAppels") là où qu'il soit puisque le N° peut-être partout dans les onglets du fichier ?
et souvent, et c'est normal suivant les traitements, le N° peut être au moins dans 2 onglets.
lionel,

Je ne dis pas qu'il faut chercher dans un seul et unique onglet, je dis qu'il faut chercher dans les bonnes colonnes quand on le peut et pas dans toutes les cellules ( ==> saturation de mémoire )

 

[Usine à gaz]

Bonjour le fil

=>Usine à gaz
Tu n'as pas répondu à la question que je posais?
Celle issue du post que je cite dans le message#47
(Sauf erreur de ma part)

Bonjour JM,
Je n'utilise pas la recherche de Job75 mais la "Recherche_youky" qui me correspond mieux pour ce que j'ai voulu faire.
C'est la seule qui reste dans le fichier joint au #post32.
lionel

 

[Staple1600]

Re

Oui mais le code job75 passait par les Array (donc plus rapide)
Et comme tu parles de gros ralentissement
D'ailleurs job75 lui-même évoque sa procédure dans le message#46

Cela t'enlèverait déjà une grosse épine du pied à mon avis.

 

[Usine à gaz]

Re

Oui mais le code job75 passait par les Array (donc plus rapide)
Et comme tu parles de gros ralentissement
D'ailleurs job75 lui-même évoque sa procédure dans le message#46

Cela t'enlèverait déjà une grosse épine du pied à mon avis.

C'est forcément vrai car les codes de Gérard sont toujours au top.
Mais je ne sais plus pourquoi je n'avais pas pu l'adapter pour qu'il correspondent exactement à mon besoin.
Je vais également m'y remettre pour voir si je ne peut pas trouver comment l'adapter.

 

[fanch55]

Bon, si bonne interprétation du code fourni,
ci-dessous une version simplifiée ( pas sûr que ce soit vraiment plus rapide ,ne portant pas sur les feuilles réelles )

Spoiler: Version simplifiée

Public Sub BoutonRecherche()

    Application.EnableEvents = False
    Application.ScreenUpdating = False
   
    With Rows(6)
        If ActiveSheet.FilterMode Then .AutoFilter
        With .Columns("A").Interior
            .Pattern = xlSolid: .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorDark1
            .TintAndShade = 0:  .PatternTintAndShade = 0
        End With
    End With
   
    Lastrow = Range("A" & Rows.Count).End(xlUp).Row
    With Range("A7:Y" & Lastrow)
        .Columns("A:U").ClearFormats
        .Columns("A").RowHeight = 40
        .Columns("W").ClearFormats
        .Columns("J").NumberFormat = "General"
        .Columns("Y").NumberFormat = "General"
    End With
    Sheets("copieappels").Rows.Hidden = False

'   Je ne vois pas l'utilité du bloc ci-dessous tout au moins dans l'exemple fourni
'    With Sheets("format-numero")
'        .Visible = True
'        .Activate
'        With [H3]
'            .Select
'            On Error Resume Next
'                ActiveSheet.PasteSpecial Format:="Texte", Link:=False, DisplayAsIcon:=False
'            On Error GoTo 0
'            NoValidCars = " .-/;,:_"
'            For i = 1 To Len(NoValidCars)
'                .Replace Mid(NoValidCars, i, 1), vbNullString, xlPart
'            Next
'
'            If .Value > 999999999# Then .Value = .Value
'            If .Value > 100000000# And .Value < 1000000000# Then .Value = 33 & .Value
'
'            .Copy
'        End With
'    End With

'----------------------------------------------
    Recherche_youky
    ClearClipboard1 ' ?
'----------------------------------------------

If [as1] = "Haut Bas" Then 'est sur le n°" as1 est dans "CopieAppels"
    ActiveWindow.ScrollRow = Selection.Row
    Selection.Copy
    [H1].PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   ' [J1].FormulaR1C1 = "N° Client"
    With [Aw2:aw20000]
        .FormulaR1C1 = "=IF(OR(R1C8=RC[-42],R1C8=RC[-41]),1,"""")"
        .Copy
        .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
        .Rows.Hidden = True
        On Error Resume Next
            .SpecialCells(xlCellTypeConstants, 1).EntireRow.Hidden = False
        On Error GoTo 0
        .ClearContents
    End With
    [H1].ClearContents
    Cells(ActiveCell.Row, 1).Select
End If
' Neutralisé car pas de shape dans l'onglet
'Masque boutons si N° dans feuille SuivisAppels
If ActiveSheet.Name = "CopiesAppels" Then
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    ActiveSheet.Range("g2:g" & Range("S65536").End(xlUp).Row).SpecialCells(xlVisible).Select
    ActiveCell.Select
    Dim x As Range
    Set x = Sheets("SuivisAppels").Range("g7:h20000").Find(ActiveCell, , xlValues, xlPart, , , False)
    If Not x Is Nothing Then 'si trouve
        ActiveSheet.Shapes("CopieAppels_Button 1").Visible = False
        ActiveSheet.Shapes("CopieAppels_Flèche vers le bas 9").Visible = False
        [S1] = "Ci-dessous vos commentaires :" & Chr(10) & _
        "Votre N° est également dans votre feuille ""SuivisAppels""" & Chr(10) & _
        "Allez dans votre feuille pour le traiter"
        End
    Else
        ActiveSheet.Shapes("CopieAppels_Button 1").Visible = True
        ActiveSheet.Shapes("CopieAppels_Flèche vers le bas 9").Visible = True
           [S1] = "La ligne de ce N° n'est pas ou plus dans ""SuivisAppels"". Pour la réintégrer :" & Chr(10) & _
           "1 - Si plusieurs lignes sont affichées pour le même n°, Choisissez en cliquant dans une cellule de la ligne du dernier appel" & Chr(10) & _
           "2 - Clic sur bouton ""Réintègrez votre Appel"", la ligne sera transférée en dernière ligne"
        'MsgBox ("IMPORTANT : Si vous quittez CopieAppels avant réintégration, vous devrez refaire votre recherche pour retrouver votre ligne" & nbcel)
        CreateObject("Wscript.shell").Popup "Si vous quittez CopieAppels avant réintégration," & Chr(10) & _
        "vous devrez refaire votre recherche pour retrouver votre ligne", 1, "IMPORTANT :"
    End If
End If
Application.ScreenUpdating = True
Application.EnableEvents = True
'Application.Calculation = xlAutomatic
End Sub
Sub Bloquefeuilles()
End Sub

Sub Recherche_youky()
Dim Trouve As Boolean
Titre = "Recherche Youki"
Application.ScreenUpdating = True

Onglets = Array("SuivisAppels", "CopieAppels", "RendezVous", "NPA")
Targets = Array("G:H", "G:H", "H:I", "G:H")

With Sheets("format-numero"): .[H3] = "": .Visible = False: End With

No = InputBox("Cherche N° Client :" & vbLf & _
              "      - Si pas de n°," & vbLf & _
              "            - ou erreur n°," & vbLf & _
              "                  Recommencez !", "Recherche")
If No <> vbNullString Then
    For i = 0 To UBound(Onglets)
        With Sheets(Onglets(i)).UsedRange.Columns(Targets(i))
            Set C = .Find(No, LookAt:=xlPart)
            If Not C Is Nothing Then
                Trouve = True
                Do
                    .Parent.Activate
                    Select Case Onglets(i)
                        Case "CopieAppels": C.RowHeight = 50
                        Case "SuivisAppels"
                            Rows(6).Copy
                            Rows(C.Row).PasteSpecial Paste:=xlPasteFormats
                            C.RowHeight = 200
                    End Select
                    C.Select
                    ActiveWindow.ScrollRow = C.Row
   
                    If MsgBox(C & " : OK dans " & Onglets(i) & vbLf & vbLf & _
                        "Cellule - ligne :  " & C.Address & vbLf & vbLf & _
                        "Continuer la recherche ?", vbQuestion + vbYesNo, Titre) = vbNo _
                    Then Exit For
                   
                    If firstAddress = "" Then firstAddress = C.Address
                    Set C = .FindNext(C)
                    If C.Address = firstAddress Then
                        Set C = Nothing
                        firstAddress = vbNullString
                    End If
                Loop While Not C Is Nothing
            Else
                If Onglets(i) = "SuivisAppels" Then _
                    If MsgBox(Onglets(i) & " votre N° " & No & " est absent ! " & vbLf & _
                            "Continuer la recherche ?", _
                            vbQuestion + vbYesNo, Titre) = vbNo Then Exit For
            End If
        End With
    Next
    If i > UBound(Onglets) Then _
    MsgBox "Ben NON : y'a " & IIf(Trouve, "plus", "pas") & "  de " & No & " !", vbCritical, Titre
End If
' Sheets("SuivisAppels").Activate
Application.ScreenUpdating = False
Bloquefeuilles
End Sub

Attention: version corrigée à 20:05

 

[Usine à gaz]

Bonjour fanch55, le Forum,
Bon dimanche à toutes et à tous

Vraiment Merci à toi pour ce code.
Je vois ça dès que j'ai un moment et je te dirai
lionel,

 

[Usine à gaz]

Bonjour le Forum et mes chers intervenants sur ce fil.

Je suis désolé de ne pas être encore revenu sur le sujet mais je n'arrive pas à "décortiquer" les codes de mon usine à gaz.

Dès que possible, je prendrai plus de temps pour voir et je ferai en sorte que le travail de "fanch55" ne soit pas tu temps pour tien.

Mes remerciements à tous
Amicalement,
lionel,

 

[soan]

Bonjour Lionel,

tu as écrit : « mais je n'arrive pas à "décortiquer" les codes de mon usine à gaz. »

en général, dans ce genre de situation, je crois bien qu'on envoie les sapeurs pompiers, ou même, pour plus de sécurité, des robots téléguidés. on sait jamais, hein ? en cas d'explosion qui soufflerait tout un quartier ! c'est qu'avec tes expériences scientifiques, tu s'rais bien capable de faire exploser le site XLD !

le pire, c'est que si l'auteur du code VBA lui-même n'arrive pas à s'y retrouver, alors quel espoir reste-t-il aux simples mortels qui n'ont pas eu le privilège de pénétrer les multiples arcanes mystérieuses de ton usine à gaz ? faut espérer qu'ton super-héros job75 pourra venir à la rescousse ! c'est là où on apprend que job75 est le superman du VBA ! il est p't'être marié à Loïs Lane (du Daily Planet) ? ​

soan