Discussion :

[d.tellier]

Bonjour,
J'aimerais écrire une macro pour numéroter chaque ligne qui s'affiche suite à un filtre.

merci.
Cordialement.

[cerede2000]

Bonjour,

Regardes ici
En formule.

[Oliv-]

Voici un exemple :

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
Sub lignesfilrees()
    Dim LignesFiltrees As Range
    Dim CountLignes
    Dim Zone As Range
    Dim ligne As Range
 
    Set LignesFiltrees = ActiveSheet.Range("_FilterDataBase").Offset(1, 0).Resize(Range("_FilterDataBase"). _
                                                                                  Rows.Count - 1).SpecialCells(xlCellTypeVisible)
    LignesFiltrees.Select
    MsgBox LignesFiltrees.Address
    CountLignes = 0
    For Each Zone In LignesFiltrees.Areas
        For Each ligne In Zone.Rows
        'Ici je fais quelque chose avec ma ligne
            CountLignes = CountLignes + 1
        Next ligne
    Next Zone
    Debug.Print CountLignes
End Sub

[ZX12R]

Bonjour,

Sinon, tout simplement...

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
Option Explicit
 
Sub test()
Dim Cpt As Integer
 
Cpt = 1
Range("A5").Select
Do While ActiveCell <> 0
    If ActiveCell.Height <> 0 Then 'ligne visible
        ActiveCell.Offset(0, 5) = Cpt
        Cpt = Cpt + 1
    End If
    ActiveCell.Offset(1, 0).Select
Loop
 
End Sub

Rem : ma liste commence en A5, et mon compteur est ds la 5e colonne !

Mais bon les autres solutions doivent surement être judicieuses.

Cordialement.

Bruno

[joe.levrai]

Bonjour,

My 2 Cents

Code :

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

1
2
3
4
5
6
7
Sub mesfiltres()
Dim Cell As Range, i As Long
    For Each Cell In ActiveSheet.UsedRange.Columns(1).SpecialCells(xlCellTypeVisible)
        Cell.Offset(0, 1).Value = i
        i = i + 1
    Next Cell
End Sub

adapter le offset bien sûr, ou alors procéder sur ce modèle à adapter

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
Sub mesfiltres()
Dim Cell As Range, i As Long, Colonne As Long
    With ActiveSheet
        Set Cell = .Rows(1).Find(0, , , xlWhole)
        If Not Cell Is Nothing Then
            Colonne = Cell.Column
            Cell.EntireColumn.Delete
        Else
            Colonne = .UsedRange.Columns.Count + 1
        End If
 
        For Each Cell In .UsedRange.Columns(1).SpecialCells(xlCellTypeVisible)
            Cell.Offset(0, Colonne - 1).Value = i
            i = i + 1
        Next Cell
    End With
End Sub