Discussion :

[olivierCT]

Bonjour à tous
Grâce à l'aide de Laetitia et Qwazerty j'ai pu batir cette macro qui fonctionne parfaitement avec Excel 2000 (c'est une liste de 36000 lignes avec des cellules qui ont parfois jusqu'à 3000 caractères) Quelqu'un aurait-il une explication au fait que sur Excel 2003, la macro sort de la boucle avant de terminer la réinjection des lignes filtrées (sur la ligne Resize) . Si je commente On error, le plantage produit le message "erreur définie par l'application".

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Sub FiltrerTab()
Dim Montab As Variant
Dim x As Long, I As Long, k As Long
Dim varFiltre() As variant
On Error Resume Next
Application.ScreenUpdating = False
Montab = Range("a1:e" & Range("a65536").End(xlUp).Row)
 x = 1
For I = 1 To UBound(Montab)
If InStr(Montab(I, 5), critere) <> 0 Then   ' critere = sous-chaine à repérer
ReDim Preserve varFiltre(1 To 5, 1 To x)
For k = 1 To 5
varFiltre(k, x) = Montab(I, k)
Next k: x = x + 1: End If: Next I
varFiltre = InverseTab(varFiltre, 1)
Sheets(sheets.count).Range("A1").Resize(UBound(varFiltre, 1), UBound(varFiltre, 2)) = varFiltre  
Erase Montab, varFiltre
Application.ScreenUpdating = True
End Sub
 
Function InverseTab(T, Optional Base As Byte = 0) 'Zon
'Base par défaut est à 0 mais si on est en base 1 lui donnner la valeur 1
Dim Temp() , I As Long, J As Long
ReDim Temp(Base To UBound(T, 2), Base To UBound(T))
For I = LBound(T, 2) To UBound(T, 2)
For J = LBound(T) To UBound(T)
Temp(I, J) = T(J, I)
Next J
Next I
InverseTab = Temp
End Function

Olivier

[Qwazerty]

Salut
J'ai repris ton 1er poste pour avoir plus d'explication sur ce que tu souhaitais faire
Ton code est bien compliqué pour rien en fait, regarde ce code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Range("E4").AutoFilter Field:=5, Criteria1:="=*gg*"

Il te permet de faire un tri sur ta colonne E, en gardant toutes les ligne contenant gg.

Adapte ca pour garder les ligne contenant critère, et copie les ligne visible (cells.Speciallcells(...)

A+
Qwaz

[olivierCT]

J'avais d'abord pensé à ta solution ( d'ailleurs pas besoin de macro :filtre automatique/personnalisé/contient). Malheureusement, comme indiqué, je crois, dans un de mes posts précédents, j'ai nombre de cellules qui contiennent plus de 256 caractères et je me suis aperçu que la sous-chaine à trier n'est pas repéré par l'autofiltre quand elle se situe au delà du 256ème caractère et qu'on filtre sur pluseiurs milliers de lignes. D'ou ma recherche d'une solution plus compliquée. J'aimerais vraiment comprendre pourquoi ça ne marche pas sur Excel 2003 !!

Olivier

[laetitia]

bonjour olivierCT l ami Qwazerty le forum en fractionnant en 10 blocs en rapidite aussi rapide peut etre meme plus vite!! a tester avec un peu de chance

Option Explicit

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
Dim a As Long, d As Long, c As Long, Montab As Variant, x As Long, I As Long, k As Long, varFiltre() As Variant
Dim z As Byte, b As Long
Sub calcul()
c = Cells.Find("*", , , , , xlPrevious).Row / 10
 Application.ScreenUpdating = False
d = 1
For z = 1 To 10
a = d: b = c + d: FiltrerTab
d = d + c + 1
Next z
Application.ScreenUpdating = True
 End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub FiltrerTab()
On Error Resume Next
 Montab = Range("A" & a & ":e" & b)
 x = 1
For I = 1 To UBound(Montab)
If InStr(Montab(I, 5), critere) <> 0 Then
ReDim Preserve varFiltre(1 To 5, 1 To x)
For k = 1 To 5
varFiltre(k, x) = Montab(I, k)
Next k: x = x + 1: End If: Next I
varFiltre = InverseTab(varFiltre, 1)
Sheets(Sheets.Count).Range("a65536").End(xlUp).Offset(1, 0).Resize(UBound(varFiltre, 1), UBound(varFiltre, 2)) = varFiltre
Erase Montab, varFiltre
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Function InverseTab(T, Optional Base As Byte = 0) 'Zon
Dim Temp(), I As Long, J As Long
ReDim Temp(Base To UBound(T, 2), Base To UBound(T))
For I = LBound(T, 2) To UBound(T, 2)
For J = LBound(T) To UBound(T)
Temp(I, J) = T(J, I)
Next J
Next I
InverseTab = Temp
End Function

[Qwazerty]

Salut
Déso Leti mais je n'ai pas regardé ta proposition, j'ai du guacamole a faire pour ce soir
Voila ce que je propose, reste visible uniquement les ligne contenant Critere (bien que je ne sache pas trop ca que tu mets dans Critere, a toi par la suite de copier les cellule qui restent visible.
A++
Qwaz

[laetitia]

salut l ami idee peut etre super bonne idee il faut voir le temps que ca met pour cacher. comme tu dis c est quoi le critere . la moi j ai rien tester je suis parti dans l esprit ce qu il disait dans son ancien post ca bogue des qu il recupere 53 lignes sur les 83 desirees il a peut etre simplement un pb.. de memoire sur le pc vu qu il utilise bien erase tablo. enfin je vais arreter la pour aujourd hui passe une bonne soiree Qwazerty
a+ leti