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

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
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 :
VB:
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,
 
Dernière édition:

laurent950

XLDnaute Accro
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

XLDnaute Barbatruc
Avec des tableaux VBA la recherche est rapide :
VB:
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

XLDnaute Barbatruc
Supporter XLD
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" :
VB:
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,
 

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
Re- Gérard,

J'ai entré ton code comme ceci :
VB:
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 :)
 

Discussions similaires

Réponses
8
Affichages
447
Réponses
12
Affichages
537

Statistiques des forums

Discussions
311 724
Messages
2 081 936
Membres
101 844
dernier inscrit
pktla