recherche sur plusieurs onglets

[heho13]

bonjour,

Peut on faire une recherche sur un fichier de plusieurs onglets.

un ex en pj

merci

 

[Gen Rose]

Re : recherche sur plusieurs onglets

Bonjour heho13
Le Forum,

Habituellement, lorsque je cherche un mot sur plusieurs onglets je fait Ctrl+F; j'inscrit mon mot; je clique sur Options; Avec Dans, je choisi Classeur.

Sauf que, en regardant le résultat souhaité, il me semble que c'est plutôt un report de données que tu souhaites et ce, sans doublons. C'est un tout autre sujet!

À vue d'oeil, comme les données à reporter peuvent se retrouver partout dans la feuille sans aucune autre référence, il faudrait un code VBA pour balayer toutes les feuilles et les reporter en Feuil1 'resultat'.

Ceci dit, est-ce pour un autre travail plus complexe où il y a des tableaux? Car si c'est le cas, il serait plus utile d'avoir le document dans sa forme originale avec des données factices afin de tester des solution.

Cdt,

 

[heho13]

Re : recherche sur plusieurs onglets

Bonsoir,

Oui c est bien des reports de donnée
Pouvez vous me montrer un exemple

Je vous fait l ex pour demain
Merci

 

[CISCO]

Re : recherche sur plusieurs onglets

Bonsoir

Peut être avec ça :
https://www.excel-downloads.com/thr...nctionnant-pas-sur-plusieurs-feuilles.211406/

@ plus

 

[job75]

Re : recherche sur plusieurs onglets

Bonsoir heho13, Geneviève, CISCO,

Une solution VBA dans le fichier joint :

Sub Recherche()
Dim d As Object, w As Worksheet, tablo, t
'---recherche des textes sans doublon--
Set d = CreateObject("Scripting.dictionary")
For Each w In Worksheets
  If w.Name <> "resultat" Then
    tablo = w.UsedRange 'matrice, plus rapide
    For Each t In tablo
      If Not IsNumeric(t) Then d(t) = ""
    Next
  End If
Next
'---résultat---
With Sheets("resultat")
  If d.Count Then
    .[B9].Resize(d.Count) = Application.Transpose(d.keys)
    .[B9].Resize(d.Count).Sort .[B9], xlAscending, Header:=xlNo 'tri
  End If
  .Range("B" & 9 + d.Count & ":B" & .Rows.Count).ClearContents
End With
End Sub

A+

 

[job75]

Re : recherche sur plusieurs onglets

Re,

En fait c'est plus compliqué car si une feuille est vide ou ne contient qu'une donnée la macro précédente beugue.

Donc utiliser :

Sub Recherche()
Dim d As Object, w As Worksheet, tablo, t
'---recherche des textes sans doublon--
Set d = CreateObject("Scripting.dictionary")
For Each w In Worksheets
  If w.Name <> "resultat" Then
    tablo = w.UsedRange 'matrice, plus rapide
    If Application.CountA(tablo) < 2 Then
      If Not IsNumeric(tablo) Then d(tablo) = ""
    Else
      For Each t In tablo
        If Not IsNumeric(t) Then d(t) = ""
      Next
    End If
  End If
Next
'---résultat---
With Sheets("resultat")
  If d.Count Then
    .[B9].Resize(d.Count) = Application.Transpose(d.keys)
    .[B9].Resize(d.Count).Sort .[B9], xlAscending, Header:=xlNo 'tri
  End If
  .Range("B" & 9 + d.Count & ":B" & .Rows.Count).ClearContents
End With
End Sub

Fichier (2).

A+

 

[job75]

Re : recherche sur plusieurs onglets

Re,

Merci pour le Like Geneviève, mais je fais mumuse

Avec le formatage en Feuil6 du fichier (3), de nouveau il y avait bug.

Alors ceci fonctionnera dans tous les cas :

Sub Recherche()
Dim d As Object, w As Worksheet, tablo, t
'---recherche des textes sans doublon---
Set d = CreateObject("Scripting.dictionary")
For Each w In Worksheets
  If w.Name <> "resultat" Then
    If w.UsedRange.Count < 2 Then
      If Not IsNumeric(w.UsedRange.Value) Then d(w.UsedRange.Value) = ""
    Else
      tablo = w.UsedRange 'matrice, plus rapide
      For Each t In tablo
        If Not IsNumeric(t) Then d(t) = ""
      Next
    End If
  End If
Next
'---résultat---
With Sheets("resultat")
  If d.Count Then
    .[B9].Resize(d.Count) = Application.Transpose(d.keys)
    .[B9].Resize(d.Count).Sort .[B9], xlAscending, Header:=xlNo 'tri
  End If
  .Range("B" & 9 + d.Count & ":B" & .Rows.Count).ClearContents
End With
End Sub

A+

 

[Gen Rose]

Re : recherche sur plusieurs onglets

Bien là, c'est du perfectionnisme! Bien anticipé je me garde celui-là au chaud, ça peut toujours servir...

 

[heho13]

Re : recherche sur plusieurs onglets

Merci
J essaye

 

[job75]

Re : recherche sur plusieurs onglets

Bonsoir le fil,

Je repasse par là avec un complément.

En effet, même sur Excel 2010, Application.Transpose ne peut pas transposer plus de 65536 items.

Dans ce cas il faut faire la transposition item par item :

Sub Recherche()
Dim d As Object, w As Worksheet, tablo(), t, a, i&
'---recherche des textes sans doublon---
Set d = CreateObject("Scripting.dictionary")
For Each w In Worksheets
  If w.Name <> "resultat" Then
    If w.UsedRange.Count < 2 Then
      If Not IsNumeric(w.UsedRange.Value) Then d(w.UsedRange.Value) = ""
    Else
      tablo = w.UsedRange 'matrice, plus rapide
      For Each t In tablo
        If Not IsNumeric(t) Then d(t) = ""
      Next
    End If
  End If
Next
'---résultat---
With Sheets("resultat")
  If d.Count Then
    a = d.keys
    ReDim tablo(UBound(a), 0)
    For i = 0 To UBound(a) 'transposition
      tablo(i, 0) = a(i)
    Next
    .[B9].Resize(d.Count) = tablo
    .[B9].Resize(d.Count).Sort .[B9], xlAscending, Header:=xlNo 'tri
  End If
  .Range("B" & 9 + d.Count & ":B" & .Rows.Count).ClearContents
End With
End Sub

Fichier (4) .xlsm joint donnant un résultat jusqu'à la ligne 100017.

A+

 

[job75]

Re : recherche sur plusieurs onglets

Bonjour heho13, le forum,

Suivant la version Excel utilisée, on peut se donner la hauteur maximum du tableau des résultats, avec éventuellement plusieurs colonnes.

Les items sont triés par la macro Quick sort :

Sub Recherche()
Dim d As Object, w As Worksheet, tablo(), t, dc&, a, h&, col%, i&, j%, n&
'---recherche des textes sans doublon---
Set d = CreateObject("Scripting.dictionary")
For Each w In Worksheets
  If w.Name <> "resultat" Then
    If w.UsedRange.Count < 2 Then
      If Not IsNumeric(w.UsedRange) Then d(w.UsedRange) = ""
    Else
      tablo = w.UsedRange 'matrice, plus rapide
      For Each t In tablo
        If Not IsNumeric(t) Then d(t) = ""
      Next
    End If
  End If
Next
'---résultat---
With Sheets("resultat")
  dc = d.Count
  If dc Then
    a = d.keys
    Call tri(a, 0, dc - 1)
    h = 50000 'hauteur maximum du tableau de résultat, à adapter
    col = Application.RoundUp(dc / h, 0)
    ReDim tablo(1 To h, 1 To col) 'base 1
    Do
      i = i + 1
      For j = 1 To col
        tablo(i, j) = a(n)
        n = n + 1
        If n = dc Then Exit Do
      Next
    Loop
    .[B9].Resize(i, col) = tablo
  End If
  .Range(.Columns(col + 2), .Columns(.Columns.Count)).ClearContents
  .Rows(i + 9 & ":" & .Rows.Count).ClearContents
End With
End Sub

Sub tri(a, gauc, droi)          ' Quick sort
Dim ref, g, d, temp
ref = a((gauc + droi) \ 2)
g = gauc: d = droi
Do
    Do While a(g) < ref: g = g + 1: Loop
    Do While ref < a(d): d = d - 1: Loop
    If g <= d Then
      temp = a(g): a(g) = a(d): a(d) = temp
      g = g + 1: d = d - 1
    End If
Loop While g <= d
If g < droi Then Call tri(a, g, droi)
If gauc < d Then Call tri(a, gauc, d)
End Sub

Fichier (5) .xls joint.

A+