Discussion :

[philoflore]

Bonjour à tous,

Objectif : Afficher les adresses des cellules sélectionnées dans le résultat d'un filtre. Code valable pour les 3 cas suivants :

Contexte : soit une liste de valeurs dans les cellules de A1 à B6 avec un filtre (données / filtre / filtre automatique)

1er cas :
Un filtre sur la colonne B permet d'afficher les lignes 1,2,3,5,6 de cette liste.

Je sélectionne A3 et A5 (cliqué glissé, A4 n'est pas visible) + A6 (avec Ctrl).

Objectif : afficher dans la cellule C1 (avec du code VBA) uniquement les adresses des cellules filtrées et sélectionnées.

Pour cet exemple, dans la cellule C1 doit s'afficher A3;A5;A6 ou $A$3;$A$5;$A$6

2ème cas
Même résultat du filtre précédent.
Si je sélectionne uniquement A6. C1 doit afficher A6 ou $A$6

3ème cas
Je ne filtre pas la liste, je sélectionne une ou plusieurs cellules dans la colonne A.
Résultat attendu : les adresse des cellules s'affichent en C1.


Un grand merci à la personne qui peut m'apporter la solution.

[fring]

Bonjour,

Une solution éventuelle

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
Sub test()
Dim cel As Range, coll As New Collection, i As Integer
 
Cells(1, 3).ClearContents
 
For Each cel In Selection
    If cel.Rows.Hidden = False Then coll.Add cel.Address
Next
 
For i = 1 To coll.Count
    If Cells(1, 3) = "" Then
        Cells(1, 3) = coll(i)
    Else
        Cells(1, 3) = Cells(1, 3) & ";" & coll(i)
    End If
Next
 
End Sub

[fring]

Autre solution (je ne sais pas pourquoi je me suis em...der à passer par une collection, ça me traversait l'esprit à ce moment là )

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
Sub test2()
Dim cel As Range
 
Cells(1, 3).ClearContents
 
For Each cel In Selection
    If cel.Rows.Hidden = False Then
        If Cells(1, 3) = "" Then
            Cells(1, 3) = cel.Address
        Else
            Cells(1, 3) = Cells(1, 3) & ";" & cel.Address
        End If
    End If
Next
 
End Sub

[philoflore]

Un grand merci à toi Fring bravo bravo bravo !!!