Autres recherche sur plusieurs colonnes excel 2007

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion chilo
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
C

chilo

XLDnaute Occasionnel
Bonsoir le forum

J'appelle de nouveau à l'aide pour résoudre un petit problème

je souhaite faire une recherche sur plusieurs feuilles et colonnes
des chiffres en surbrillance et les retourner dans une feuille appelée récapitulation
avec le numéro du compteur en vba si possible
en vous remerciant par avance pour votre aide
 

Pièces jointes

Trier par date Trier par votes
Voyez le fichier joint et cette macro dans le code de la feuille "Récapitulation" :
VB: 
Private Sub Worksheet_Activate()
Dim critere, ub%, resu(), w As Worksheet, tablo, i&, copie As Boolean, j%, n&
critere = Feuil1.[B4:F4] 'vecteur ligne, plus rapide
ub = UBound(critere, 2)
ReDim resu(1 To Rows.Count, 1 To ub + 3)
For Each w In Worksheets
    If w.Name <> Me.Name Then
        tablo = w.Range("A6").CurrentRegion.Resize(, ub + 2) 'matrice, plus rapide
        For i = 1 To UBound(tablo)
            copie = True
            For j = 1 To ub
                If tablo(i, j + 1) <> critere(1, j) Then copie = False: Exit For
            Next j
            If copie Then
                n = n + 1
                resu(n, 1) = tablo(i, 1)
                For j = 1 To ub: resu(n, j + 1) = critere(1, j): Next j
                resu(n, ub + 2) = tablo(i, ub + 2)
                resu(n, ub + 3) = w.Name
            End If
        Next i
    End If
Next w
'---restitution---
Application.ScreenUpdating = False
If FilterMode Then ShowAllData 'si la feuille est filtrée
With [A7] '1ère cellule de validation, à adapter
    Intersect(.CurrentRegion, Rows(.Row).Resize(Rows.Count - .Row + 1)).ClearContents 'RAZ
    If n Then .Resize(n, ub + 3) = resu
End With
With UsedRange: End With 'ajuste les barres de défilement
End Sub
Elle se déclenche quand on active la feuille.

Elle est très rapide car on utilise des tableaux VBA et que la restitution se fait en bloc.

Je pense que Feuil3 était erronée, je l'ai corrigée et le résultat est bien celui indiqué au post #1.

Bonjour sylvanu.
 

Pièces jointes

Vote positif 0 Vote négatif
Bonsoir sylvanu, Job75

Je vous remercie tous les deux pour votre réponse,
Mais la méthode de Sylvanu répond tout à fait à ce que je souhaite car je trouve dans mes
tableurs des nombres dans le désordre

Toutefois, le dernier de Job5 est très rapide
encore une fois merci pour l'aide apportée
 
Vote positif 0 Vote négatif
Alors si les chiffres à rechercher peuvent être dans le désordre ce n'est guère plus difficile.

Mais toujours pour aller vite il faut les lister dans un Dictionary, voyez ce fichier (2) et la macro :
VB: 
Private Sub Worksheet_Activate()
Dim critere, ub%, d As Object, e, resu(), w As Worksheet, tablo, i&, copie As Boolean, j%, n&
critere = Feuil1.[B4:F4] 'vecteur ligne, plus rapide
ub = UBound(critere, 2)
Set d = CreateObject("Scripting.Dictionary")
'---liste des éléments de critère sans doublon---
For Each e In critere: d(e) = "": Next e
'---tableau des résultats---
ReDim resu(1 To Rows.Count, 1 To ub + 3)
For Each w In Worksheets
    If w.Name <> Me.Name Then
        tablo = w.Range("A6").CurrentRegion.Resize(, ub + 2) 'matrice, plus rapide
        For i = 1 To UBound(tablo)
            copie = True
            For j = 1 To ub
                If Not d.exists(tablo(i, j + 1)) Then copie = False: Exit For
            Next j
            If copie Then
                n = n + 1
                For j = 1 To ub + 2: resu(n, j) = tablo(i, j): Next j
                resu(n, ub + 3) = w.Name
            End If
        Next i
    End If
Next w
'---restitution---
Application.ScreenUpdating = False
If FilterMode Then ShowAllData 'si la feuille est filtrée
With [A7] '1ère cellule de validation, à adapter
    Intersect(.CurrentRegion, Rows(.Row).Resize(Rows.Count - .Row + 1)).ClearContents 'RAZ
    If n Then .Resize(n, ub + 3) = resu
End With
With UsedRange: End With 'ajuste les barres de défilement
End Sub
J'ai remis Feuil3 avec B19:F19 comme c'était au départ.
 

Pièces jointes

Vote positif 0 Vote négatif
BONSOIR LE FORUM

je l'ai essayé cela fonctionne, mais le soucis le nom des feuille
job75 à dit:
Alors si les chiffres à rechercher peuvent être dans le désordre ce n'est guère plus difficile.

Mais toujours pour aller vite il faut les lister dans un Dictionary, voyez ce fichier (2) et la macro :
VB: 
Private Sub Worksheet_Activate()
Dim critere, ub%, d As Object, e, resu(), w As Worksheet, tablo, i&, copie As Boolean, j%, n&
critere = Feuil1.[B4:F4] 'vecteur ligne, plus rapide
ub = UBound(critere, 2)
Set d = CreateObject("Scripting.Dictionary")
'---liste des éléments de critère sans doublon---
For Each e In critere: d(e) = "": Next e
'---tableau des résultats---
ReDim resu(1 To Rows.Count, 1 To ub + 3)
For Each w In Worksheets
    If w.Name <> Me.Name Then
        tablo = w.Range("A6").CurrentRegion.Resize(, ub + 2) 'matrice, plus rapide
        For i = 1 To UBound(tablo)
            copie = True
            For j = 1 To ub
                If Not d.exists(tablo(i, j + 1)) Then copie = False: Exit For
            Next j
            If copie Then
                n = n + 1
                For j = 1 To ub + 2: resu(n, j) = tablo(i, j): Next j
                resu(n, ub + 3) = w.Name
            End If
        Next i
    End If
Next w
'---restitution---
Application.ScreenUpdating = False
If FilterMode Then ShowAllData 'si la feuille est filtrée
With [A7] '1ère cellule de validation, à adapter
    Intersect(.CurrentRegion, Rows(.Row).Resize(Rows.Count - .Row + 1)).ClearContents 'RAZ
    If n Then .Resize(n, ub + 3) = resu
End With
With UsedRange: End With 'ajuste les barres de défilement
End Sub
J'ai remis Feuil3 avec B19:F19 comme c'était au départ.
Cliquez pour agrandir...
bonsoir job j'allais répondre MERCI pour la modification
 
Vote positif 0 Vote négatif
Bonjour le forum

POur compléter la chose

Est il possible de compter le nombre de fois
que 1 2 3 4 5 est compris dans la recherche

Merci de bien vouloir jeter un oeil ( et le récupérer bien sûr après)
Merci beaucoup de votre
 
Vote positif 0 Vote négatif
Bonjour chilo, le forum,
chilo à dit:
Est il possible de compter le nombre de fois
que 1 2 3 4 5 est compris dans la recherche
Cliquez pour agrandir...
Voyez ce fichier (3) avec les comptages dans l'ordre et dans le désordre :
Code: 
Private Sub Worksheet_Activate()
Dim critere, ub%, d As Object, e, resu(), w As Worksheet, tablo, i&, copie As Boolean, j%, n&, nn&
critere = Feuil1.[B4:F4] 'vecteur ligne, plus rapide
ub = UBound(critere, 2)
Set d = CreateObject("Scripting.Dictionary")
'---liste des éléments de critère sans doublon---
For Each e In critere: d(e) = "": Next e
'---tableau des résultats---
ReDim resu(1 To Rows.Count, 1 To ub + 4)
For Each w In Worksheets
    If w.Name <> Me.Name Then
        tablo = w.Range("A6").CurrentRegion.Resize(, ub + 2) 'matrice, plus rapide
        For i = 1 To UBound(tablo)
            copie = True
            For j = 1 To ub
                If Not d.exists(tablo(i, j + 1)) Then copie = False: Exit For
            Next j
            If copie Then
                n = n + 1 'comptage global
                resu(n, 1) = tablo(i, 1)
                For j = 1 To ub
                    resu(n, j + 1) = tablo(i, j + 1)
                    If resu(n, j + 1) <> critere(1, j) Then copie = False
                Next j
                If copie Then nn = nn + 1 'comptage dans l'ordre
                resu(n, ub + 2) = tablo(i, ub + 2)
                resu(n, ub + 3) = w.Name
                resu(n, ub + 4) = "dans " & IIf(copie, "l'ordre", "le désordre")
            End If
        Next i
    End If
Next w
'---restitution---
Application.ScreenUpdating = False
If FilterMode Then ShowAllData 'si la feuille est filtrée
With [A7] '1ère cellule de validation, à adapter
    Intersect(.CurrentRegion, Rows(.Row).Resize(Rows.Count - .Row + 1)).ClearContents 'RAZ
    If n Then .Resize(n, ub + 4) = resu
End With
With UsedRange: End With 'ajuste les barres de défilement
Application.ScreenUpdating = True
MsgBox n & " ligne(s) trouvée(s) dont " & nn & " dans l'ordre et " & n - nn & " dans le désordre", vbInformation, "Recherche"
End Sub
Bonne journée.
 

Pièces jointes

Vote positif 0 Vote négatif
job75 à dit:
Bonjour chilo, le forum,

Voyez ce fichier (3) avec les comptages dans l'ordre et dans le désordre :
Code: 
Private Sub Worksheet_Activate()
Dim critere, ub%, d As Object, e, resu(), w As Worksheet, tablo, i&, copie As Boolean, j%, n&, nn&
critere = Feuil1.[B4:F4] 'vecteur ligne, plus rapide
ub = UBound(critere, 2)
Set d = CreateObject("Scripting.Dictionary")
'---liste des éléments de critère sans doublon---
For Each e In critere: d(e) = "": Next e
'---tableau des résultats---
ReDim resu(1 To Rows.Count, 1 To ub + 4)
For Each w In Worksheets
    If w.Name <> Me.Name Then
        tablo = w.Range("A6").CurrentRegion.Resize(, ub + 2) 'matrice, plus rapide
        For i = 1 To UBound(tablo)
            copie = True
            For j = 1 To ub
                If Not d.exists(tablo(i, j + 1)) Then copie = False: Exit For
            Next j
            If copie Then
                n = n + 1 'comptage global
                resu(n, 1) = tablo(i, 1)
                For j = 1 To ub
                    resu(n, j + 1) = tablo(i, j + 1)
                    If resu(n, j + 1) <> critere(1, j) Then copie = False
                Next j
                If copie Then nn = nn + 1 'comptage dans l'ordre
                resu(n, ub + 2) = tablo(i, ub + 2)
                resu(n, ub + 3) = w.Name
                resu(n, ub + 4) = "dans " & IIf(copie, "l'ordre", "le désordre")
            End If
        Next i
    End If
Next w
'---restitution---
Application.ScreenUpdating = False
If FilterMode Then ShowAllData 'si la feuille est filtrée
With [A7] '1ère cellule de validation, à adapter
    Intersect(.CurrentRegion, Rows(.Row).Resize(Rows.Count - .Row + 1)).ClearContents 'RAZ
    If n Then .Resize(n, ub + 4) = resu
End With
With UsedRange: End With 'ajuste les barres de défilement
Application.ScreenUpdating = True
MsgBox n & " ligne(s) trouvée(s) dont " & nn & " dans l'ordre et " & n - nn & " dans le désordre", vbInformation, "Recherche"
End Sub
Bonne journée.
Cliquez pour agrandir...
Merci Job75, pour l'aide cela me permet de gagner énormément de temps

Encore une fois merci pour l'aide apportée
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

jeanmi
  • Résolu(e)
XL 2013 recherche de données sur plusieurs fichiers
Réponses
13
Affichages
638
dysorthographie
dysorthographie
pompaero
  • Question Question
Microsoft 365 Recherche et enregistrement document
3 4 5
Réponses
62
Affichages
2 K
dysorthographie
dysorthographie
M
  • Question Question
XL 2016 comment faire une barre de recherche
Réponses
7
Affichages
515
mumu91800
M
F
  • Question Question
XL 2016 mots en colonne et en ligne dans Excel
2
Réponses
21
Affichages
412
finarobert
F
F
  • Question Question
Microsoft 365 Problème RECHERCHEV avec plusieurs correspondances possibles pour une même valeur
2
Réponses
15
Affichages
417
floflatch22
F
E
  • Résolu(e)
Microsoft 365 ComboBox "dynamiques" sans doublon sur plusieurs colonnes
Réponses
2
Affichages
283
ExcLnoob
E
F
  • Résolu(e)
Microsoft 365 Retrouver un mot dans un autre onglet
2
Réponses
17
Affichages
255
Fitgy
F
F
  • Résolu(e)
XL 2019 Power Query - Importer plusieurs sources de données Excel en 1 seul fois
Réponses
3
Affichages
133
wDog66
wDog66
jeff1494
  • Question Question
XL 2021 Aide pour recherche intuitive
2
Réponses
16
Affichages
929
jeff1494
jeff1494
D
  • Résolu(e)
Microsoft 365 Remplissage colonne automatique dépendant d'un tableau
Réponses
7
Affichages
684
fanfan38
fanfan38
I
  • Question Question
XL 2016 Dupliquer des colonnes sur plusieurs feuilles
Réponses
2
Affichages
313
AtTheOne
AtTheOne
S
  • Résolu(e)
Microsoft 365 Liste déroulante avec plusieurs colonnes de tableaux + Recherche valeurs en fonction de la valeurs selectionnée
Réponses
2
Affichages
435
Sosobob
S
A
  • Question Question
Microsoft 365 Macro pour recherche de cellules entre 2 fichiers Excel
Réponses
7
Affichages
194
AtTheOne
AtTheOne
A
  • Question Question
Microsoft 365 recherche multicritère de la valeur suivante
2
Réponses
29
Affichages
1 K
alexga78
A
T
  • Résolu(e)
XL 2019 Filtrer certains champs au démarrage avec vba
2
Réponses
15
Affichages
495
telemarrk
T
O
  • Question Question
Power Query Convertir un tableau de colonnes en lignes avec plusieurs variables (power query)
Réponses
8
Affichages
881
oobiz
O
M
  • Résolu(e)
XL pour MAC Tirages aléatoires avec critères
2
Réponses
16
Affichages
846
crocrocro
C
M
  • Question Question
Microsoft 365 Calcul du nombre de chiffres dans une cellule. Mise en page d'un fichier.
Réponses
2
Affichages
429
MCOTTEND
M
B
  • Résolu(e)
Microsoft 365 Recherche formule
Réponses
7
Affichages
870
TooFatBoy
TooFatBoy
D
  • Question Question
XL 2016 Future date la plus proche d'aujourd'hui + mise en forme conditionnelle
Réponses
8
Affichages
273
vgendron
vgendron
Retour