Microsoft 365 rechercher uniquement de g7 jusqu'à la dernière ligne NON vide

[Usine à gaz]

Bonjour à toutes et à tous,

Je profite de cette période de fêtes, plus calme côté travail, et je tente d'améliorer mon "usine à gaz" comme dirait mon cher Gérard LOL.
J'essaie de refaire mes codes "bidouillés" avec les connaissances que j'ai acquises grâce à vos codes et explications que vous m'avez si gentiment fourni au fil du temps.

Présentement, je souhaite accélérer la recherche qui est "longue en temps d'exécution".
Cette recherche grâce aux interventions de Mapomme, Youky, Gérard, Patrick, Roland ... fonctionne très bien.
Toutefois, dans mon classeur elle se fait sur :
- 4 onglets et chaque onglet contient environ 50000 lignes et environ 45/50 colonnes... soit 10 000 000 de cellules à contrôler
Ceci, selon moi, expliquant certainement le temps de traitement.

Je pense qu'il est possible de réduire ce temps car les cellules à "visiter" sont exactement les mêmes sur tous les onglets :
- de g7:h jusqu'à la dernière ligne NON vide

Mais je n'arrive pas à coder pour que la recherche "ne visite" que de g7:h jusqu'à la dernière ligne NON vide des 4 onglets.
soit 400 000 de cellules à contrôler = 25 fois moins de cellules à visiter
Voici ci-dessous le code que j'utilise :

Sub Recherche_youky_Mapomme()
nom = InputBox("Saissisez votre N° sans espaces", "Recherche N° de Téléphone")
If nom = "" Then
Application.EnableEvents = False
Sheets("SuivisAppels").Select
Application.EnableEvents = True
Exit Sub
End If
  q = ActiveSheet.Index
  For q = q To ActiveSheet.Index + Sheets.Count - 1
    k = (q - 1) Mod (Sheets.Count) + 1
With Sheets(k).UsedRange
Set C = .Find(nom, LookIn:=xlValues)
'Set c = .Find(nom, LookAt:=xlWhole) 'cellule entière
Set C = .Find(nom, LookAt:=xlPart)   'contenu dans cellule
If Not C Is Nothing Then
firstAddress = C.Address
Do
On Error Resume Next
Sheets(k).Select
C.Activate
rep = MsgBox("Continuer la recherche ?", 4 + 32, "Sélection")
If rep = vbNo Then Exit Sub
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 !"
End Sub

Si vous aviez la solution, ça m'arrangerait vraiment car je fais des dizaines de recherche par jour.
Ce serait certainement un gain important de temps.

Un grand merci déjà pour m'avoir lu,
Amicalement,
lionel,

 

[job75]

Ce que je voudrais :
Le code cherche dans cet ordre de feuilles:
- SuivisAppels
- NPA
- CopieAppels

et qu'il affiche au fur et à mesure la cellule trouvée dans la feuille concernée

Le code fait tout ça

 

[Usine à gaz]

ça coince ici : If CStr(tablo(i, J)) Like num Then = ça c'est bon c'est que j'avais modifié
"g:h en "g:g

mais à l'exécution du code, il ne se passe rien
je vais ré-essayer en déprotégeant les feuilles et en mettant Application.EnableEvents = False

 

[Usine à gaz]

Bizarre, ile ne se passe rien "di tout" LOl

 

[job75]

A force de bricoler on finit par faire des bêtises, avec la seule colonne G utiliser :

Sub Gerard()
Dim num, w As Worksheet, tablo, i&
num = Abs(Int(Val(InputBox("Saissisez votre N° sans espaces", "Recherche N° de Téléphone"))))
If num = 0 Then Exit Sub
num = num & "*"
For Each w In Sheets(Array("SuivisAppels", "NPA", "CopieAppels"))
    With Intersect(w.UsedRange.EntireRow, w.Columns("G:H")) '2 colonnes pour avoir au moins 2 cellules
        tablo = .Value 'matrice, plus rapide
        For i = 1 To UBound(tablo)
            If CStr(tablo(i, 1)) Like num Then
                w.Visible = xlSheetVisible 'si la feuille est masquée
                Application.Goto .Cells(i, 1)
                If MsgBox("Continuer la recherche ?", 4) = 7 Then Exit Sub
            End If
        Next i
    End With
Next w
End Sub

 

[Usine à gaz]

Vraiment encore merci Gérard
je vais voir ça et je reviens.
lionel,

 

[Usine à gaz]

Je suis vraiment désolé Gerard, je te fais passer du temps ...

J'ai copié le code tel quel mais ça ne fonctionne pas.
- Il ne me dit pas s'il trouve,
- ni ne s'arrête à chaque fois qu'il trouve en se mettent dans la feuille concernée sur la cellule du N° trouvé,
- ni ne me demande de continuer ou pas ou me dire qu'il n'y en a plus,

J'essaie de voir mais je ne trouve pas la solution

 

[job75]

Chez moi pas de problème, voir le fichier joint.

 

[Usine à gaz]

Vraiment, je ne sais que dire, merci Gerard
Je regarde

 

[Usine à gaz]

Bon sang, ça marche du tonnerre
je vais voir ce soir ce qui fait que ça ne bouche pas dans mon fichier de travail.

 

[Usine à gaz]

Gérard, je suis désolé d'y revenir encore.

Dans ton fichier ça fonctionne très bien ..
Et dans mon fichier de travail
le code :
Sub Gerard()
Dim num, w As Worksheet, tablo, i&
num = Abs(Int(Val(InputBox("Saissisez votre N° sans espaces", "Recherche N° de Téléphone"))))
If num = 0 Then Exit Sub
num = num & "*"
For Each w In Sheets(Array("SuivisAppels", "NPA", "CopieAppels"))
With Intersect(w.UsedRange.EntireRow, w.Columns("G:H")) '2 colonnes pour avoir au moins 2 cellules
tablo = .Value 'matrice, plus rapide
For i = 1 To UBound(tablo)
If CStr(tablo(i, 1)) Like num Then s'arrête sur cette ligne
w.Visible = xlSheetVisible 'si la feuille est masquée
Application.Goto .Cells(i, 1)

If MsgBox("Continuer la recherche ?", 4) = 7 Then
Exit Sub
End If
End If et passe direct à celle-ci donc il ne trouve pas
Next i
End With
Next w
MsgBox "Ben NON : y'a pas ou y'a plus !"
End Sub

Je cherche pourquoi ?
lionel,

 

[Usine à gaz]

le feuilles sont protégées (mais les cellules sélectionnables)
j'ai essayé en les déprotégeant mais = pareil

 

[job75]

Bien que tu aies modifié ma macro pas de problème sur mon dernier fichier.

 

[Usine à gaz]

LOL, je vais tourner "bourrin" si ce n'est déjà le cas

Je prends ton code de ton fichier et je le copie dans le mien et ça ne marche pas.
Je reprends le code de mon fichier et je le copie dans le tien ... et ça marche.

Alors là, c'est plus fort que le roquefort !
Je me demande bien ce qui bloque ?
Je continue à chercher

 

[job75]

Faut pas avoir peur des boucles laurent950, sur des tableaux VBA elles sont ultra rapides :

Sub Test()
Dim t, tablo, i&, x
t = Timer
tablo = [A1:A1000000]
For i = 1 To UBound(tablo)
    x = tablo(i, 1)
Next
MsgBox Timer - t
End Sub