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,

 

[laurent950]

Bonjour arthour973,
Vous avez un classeur pour faire le code :
Soit les 4 onglets avec ressembles des 50 colonnes (avec leurs entêtes).
Pour chaque Onglet 25 lignes suffisent.

Des exemples de recherches :
- N° Tel
- Mots
- Phrases

Et je regarde le code

 

[job75]

Bonjour Lionel, laurent950,

Il faut savoir que la méthode Find est lente, donc l'éviter quand c'est possible.

Joyeux Noël.

 

[laurent950]

Bonsoir job75, arthour973
C'est vrais que la méthode Find n'est pas la plus rapide des méthodes.
Passer en variables tableaux sera bien plus rapide.

Laurent

 

[Usine à gaz]

Bonjour Gérard, Re-Laurent, le Forum,
Joyeux Noel

Merci Gérard pour ton conseil
Laurent, je vais faire un fichier exemple et je le joins dès que c'est prêt.
lionel,

 

[Usine à gaz]

Mais Gérard ?
En modifiant le code pour que la recherche se fasse uniquement :
de g7:h jusqu'à la dernière ligne NON vide
Ne serait-il pas déjà bien plus rapide puisque 25 fois moins de cellules à parcourir ?

 

[Usine à gaz]

Eureka !
Je crois avoir trouvé et cela semble bien plus rapide
J'ai remplacé la ligne :
Set C = .Find(nom, LookIn:=xlValues)
par
Set C = Range("g:h").Find(nom, LookIn:=xlValues)

@ Laurent, je ferai le fichier exemple pour que tu puisses aussi avancer
lionel,

 

[Usine à gaz]

pour optimiser un peu plus, j'aurais souhaité remplacer :
Set C = Range("g:h").Find(nom, LookIn:=xlValues)
par
Set C = Range de (g7:h) jusqu'à la dernière ligne NON vide .Find(nom, LookIn:=xlValues)
Pour l'instant, j'ai pas trouvé LOl

 

[job75]

Avec des tableaux VBA la recherche est rapide :

Sub Recherche()
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 Worksheets
    With Intersect(w.UsedRange.EntireRow, w.Columns("G:H"))
        tablo = .Value 'matrice, plus rapide
        For i = 1 To UBound(tablo)
            For j = 1 To 2
                If CStr(tablo(i, j)) Like num Then
                    w.Visible = xlSheetVisible 'si la feuille est masquée
                    Application.Goto .Cells(i, j)
                    If MsgBox("Continuer la recherche ?", 4) = 7 Then Exit Sub
                End If
        Next j, i
    End With
Next w
End Sub

 

[Usine à gaz]

Merci Gérard, je vais regarder

 

[Usine à gaz]

Bonjour Mapomme, Youky, Gérard, Patrick, Roland ... toutes et à tous,

Malgré mes tentatives, pour l'instant, je n'ai pas été capable d'adapter le code de Gérard pour qu'il exécute la recherche selon mon besoin.
J'utilise actuellement ce code qui fonctionne déjà plutôt bien et d'un temps d'exécution "acceptable" :

Sub Recherche_youky_Mapomme()
nom = InputBox("Saissisez votre N° sans espaces", "Recherche N° de Téléphone")
If nom = "" Then
Application.ScreenUpdating = False
MsgBox "Saisissez l'objet" & Chr(10) & "de votre recherche", vbInformation, "             Vous n'avez rien saisi !"
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 = Range("g7", Range("g1048576").End(xlUp)).Find(nom, LookIn:=xlValues)
'Set C = Range("g:g").Find(nom, LookIn:=xlValues)
Set C = .Find(nom, LookAt:=xlPart)   'contenue dans cellule - LookAt:=xlWhole) 'cellule entière
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
Application.ScreenUpdating = False
Exit Sub
End If
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
End Sub

Pour réduire encore un peu le temps d'exécution, j'aimerais exclure de la recherche les feuilles où il n'est pas utile de chercher :
par exemple exclure de la recherche les feuilles "machin", "truc", bidule" ...

Je cherche sur le net et dans les forums, j'ai fait des tentatives de profane LOL ... mais je n'ai pas encore trouvé.
Auriez-vous le bon code ?

Ensuite, quand ce code sera finalisé (me permettant de travailler dans de meilleures conditions),
Je tenterai à nouveau d'adapter le code de Gérard

Merci à tous
lionel,

 

[job75]

Malgré mes tentatives, pour l'instant, je n'ai pas été capable d'adapter le code de Gérard

Il n'y a rien à adapter, sauf peut-être remplacer For Each w In Worksheets par

For Each w In Sheets(Array("Feuil1", "Feuil2", "Feuil3", "Feuil4"))

en listant les feuilles concernées.

Ou alors avec un test If/End If pour exclure des feuilles.

 

[Usine à gaz]

Merci Gérard, je vais regarder

 

[Usine à gaz]

Re- Gérard,

J'ai entré ton code comme ceci :

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:g"))
        tablo = .Value 'matrice, plus rapide
        For i = 1 To UBound(tablo)
            For J = 1 To 2
                If CStr(tablo(i, J)) Like num Then
                    w.Visible = xlSheetVisible 'si la feuille est masquée
                    Application.Goto .Cells(i, J)
                    If MsgBox("Continuer la recherche ?", 4) = 7 Then Exit Sub
                End If
        Next J, i
    End With
Next w
End Sub

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
.
LOL, je n'y arrive pas

 

[Usine à gaz]

ça coince ici : If CStr(tablo(i, J)) Like num Then