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