Récupération Range suite Autofilter

Version imprimable

Voir 40 message(s) de cette discussion en une page

12/04/2016, 19h42
RyuAutodidacte

Re cedere,

Juste quelques petites questions à des fins d'apprentissage :

Code:

.SpecialCells(xlCellTypeBlanks).Cells

• Ce code pointe sur quelle colonne ? Est ce la colonne du field:=3?
Car si c'est le cas on est censé éliminer toutes les cellules vide de cette colonne et donc la ligne entière correspondante à cette cellule , non??

• j'ai voulu reproduire ton code sur la copie mais j'ai eu une erreur
Peux tu me mettre une demo en entier du code pour une copie feuil1 à feuil2 stp
Merci d'avance
12/04/2016, 19h55
cerede2000

Pour répondre à ta 1ere question, ce n'est pas aussi simple car dans mon traitement ensuite il y a d'autre paramètre qui viennent et qui font que le xlCellTypeBlanks me pose souci, mais dans l'absolu ça aurait répondu à mon besoin ;)
Encore que je fais déjà des insertions de lignes en bloc sur le fichier 2 ce qui prends un peu de temps alors si je doit encore en supprimer à la fin sur plus de 10000, je préfère m'en passer :)

Dis moi en plus sur l'erreur que tu rencontre avec mon code.
Qu'est ce que c'est comme erreur ?

1 pièce(s) jointe(s)

Re,
Pour les liens donnés dans ton post regarde le résultat (fichier joint + code). Après je ne sais pas si c'est la meilleure solution, mais ça marche très bien ;)
le fichier : Pièce jointe 206756

Code:

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
Sub Demo_Backup_Filtre1()
    Dim RgA_Filtre As Range, x&, ws As Worksheet, T!
    T = Timer
 
            Application.ScreenUpdating = False
    For Each ws In Worksheets
        If ws.CodeName <> "Feuil1" Then
            ws.Range("$B$12:$N$21").AutoFilter field:=3, Criteria1:="<>"
            Set RgA_Filtre = ws.Range("_FilterDataBase").SpecialCells(xlCellTypeVisible)
 
            x = 1
            For Each Areas In RgA_Filtre
                DerL& = Feuil1.Range("B" & Rows.Count).End(xlUp).Row + 1
 
                If x = 1 And RgA_Filtre.Areas(x).Rows.Count > 1 Then
                    Feuil1.Range("B" & DerL).Resize(RgA_Filtre.Areas(x).Rows.Count, 13).Value = RgA_Filtre.Areas(1).Resize(RgA_Filtre.Areas(x).Rows.Count - 1).Offset(1).Value
                Else
                    x = x + 1
                    Feuil1.Range("B" & DerL).Resize(RgA_Filtre.Areas(x).Rows.Count, 13).Value = RgA_Filtre.Areas(x).Value
                End If
                If x = RgA_Filtre.Areas.Count Then Exit For
            Next
 
        End If
     Next
                Set RgA_Filtre = Nothing
                Application.Goto Feuil1.Cells(1), True
                Application.ScreenUpdating = False
                MsgBox Format$(Timer - T, "0,000s")
End Sub

Alors ??

La partie que je ne comprends pas puisque le code n'est pas complet avec la copie est :

Code:

1
2
3
4
.Range("$B$12:$N$21").AutoFilter field:=3, Criteria1:="<>"
nbRowsVisible = .AutoFilter.Range.Columns(3).SpecialCells(xlCellTypeVisible).Count - 1
Set srcR = .AutoFilter.Range
Set srcR = srcR.Resize(srcR.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible)

13/04/2016, 08h29
cerede2000
Alors
On active le filtre (j'ai un With avec la feuille concerné) :

Code:

.Range("$B$12:$N$21").AutoFilter field:=3, Criteria1:="<>"

On récupère le nombre de ligne qui sont visible après application du filtre (-1 pour la ligne d'entête) :

Code:

nbRowsVisible = .AutoFilter.Range.Columns(3).SpecialCells(xlCellTypeVisible).Count - 1

Ça me sert ensuite pour ajouter en bloc directement le nombre de lignes nécéssaires

Si il reste des lignes après le filtre, on récupére la Range qui correspond à l'autofilter, puis on retire la ligne d'entête et on ne prends que les celulles visibles :
Code:

1 2 3 If nbRowsVisible > 0 Then Set srcR = .AutoFilter.Range Set srcR = srcR.Resize(srcR.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible)
End If[/CODE]
13/04/2016, 09h17
RyuAutodidacte

Bonjour,
Bon ok, je vais re-tester en espérant ne plus avoir d'erreur, je vais reprendre le fichier de mon post précédent qui est normalement un simili du problème énoncé.

PS : d'ailleurs, as tu pu le tester avec le code ? J'aimerai avoir ton avis !!

c'est bon j'ai réussi, par contre je ne sais pas si tu as utilisé Copy ou autre chose
j'ai aussi utilisé : ClearFormats en plus (si tu l'as pas fait??)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub test()
    Dim srcR As Range, ws As Worksheet
 
            Application.ScreenUpdating = False
 
        For Each ws In Worksheets
            If ws.CodeName <> "Feuil1" Then
                DerL& = Feuil1.Range("B" & Rows.Count).End(xlUp).Row + 1
                With ws
                    .Range("$B$12:$N$21").AutoFilter field:=3, Criteria1:="<>"
                    nbRowsVisible = .AutoFilter.Range.Columns(3).SpecialCells(xlCellTypeVisible).Count - 1
                    If nbRowsVisible > 0 Then
                        Set srcR = .AutoFilter.Range
                        Set srcR = srcR.Resize(srcR.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible)
                        srcR.Copy Destination:=Feuil1.Range("B" & DerL)
                    End If
                End With
            End If
    Next
    Feuil1.Range("B12").CurrentRegion.Offset(1).ClearFormats
 
            Application.ScreenUpdating = False
End Sub

13/04/2016, 12h05
cerede2000

Je fais un Copy/PasteSpeciale xlPasteValues ;)
13/04/2016, 13h35
RyuAutodidacte

En effet Copy/PasteSpeciale xlPasteValues est plus simple et mieux à l'utilisation que de rajouter une ligne de code avec ClearFormats

Si tu as le temps, donne moi ton avis après test du code créer Post #23 ;) :http://www.developpez.net/forums/d15...r/#post8597633
Merci pour tes réponses :ccool:

Voir 40 message(s) de cette discussion en une page