N° Lignes Visibles d'un filtre

Invité · 23/03/2013, 10h28

Bonjour,

Je voudrais savoir s'il existait un moyen ou une astuce en VBA pour connaitre les numéros des lignes visibles suite à l'application d'un filtre.

Pour réduire le nombre de lignes de ma feuille, mon idée est la suivante:
- je filtre sur col B, récupère la valeur col C (pour rechercher la 1ère occurence sur les lignes masquées), copier la valeur col I et la rajouter à la première occurence trouvée
- puis supprimer et passer à la ligne suivante

Par quelle ligne commencer, la 1ère ligne visible ou la dernière?

à moins que je ne fasse fausse route, je débute.

Je remercie toute personne qui pourrait éclairer ma lanterne.

Cordialement,
Cathodique

**Daniel.C** · 23/03/2013, 16h59

Bonjour,

Je n'ai pas trop compris ce que tu veux faire. Pour supprimer des lignes, on commence normalement par la dernière ligne et on va en remontant. Pour connaître le numéro des lignes visibles d'un filtre :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
Sub test()
    Dim Plage As Range
    With ActiveSheet.AutoFilter.Range
        Set Plage = .Offset(1).Resize(.Rows.Count - 1) 'on élimine la ligne d'entête
        If Application.Subtotal(103, Plage) > 0 Then 's'il y a des lignes visibles
            For Each c In Plage.SpecialCells(xlCellTypeVisible)
                MsgBox c.Row
            Next c
        End If
    End With
End Sub

Invité · 24/03/2013, 17h16

Bonjour,

En fait, on me demande à partir d’une feuille contenant des données, de créer un classeur de 3 feuilles et de dispatcher ces données sur ces dernières. La plus grande des difficultés est que la présentation de ces 3 feuilles diffère un peu les unes des autres.

Mes connaissances du VBA sont des plus élémentaires. J’effectue des recherches sur le net, consulte l’aide VBA (pas très claire pour moi) et utilise l’enregistreur de macros. Donc, j’avance étape par étape.

Depuis le jour de mon post, j’ai avancé mais j’ai eu des surprises. Mon code avait bien fonctionné. Mais je me suis aperçu que si on rajoutait des données, dont la première lettre avait un ordre supérieur à celui de "Tiers" (valeur utilisée dans le filtre), le résultat est catastrophique.

Je vous soumets mon code et attends vos remarques et suggestions ou me proposer une solution plus fiable.

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
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
Sub CmdP()
Dim bd As Object, dico As Object
Dim dl As Integer, i As Integer, x As Integer, lg As Integer
Dim pl As Range, cel As Range
Dim temp As Variant
Dim enObs As String
 
'Application.ScreenUpdating = False
Set bd = Sheets("BD") 'définit l'onglet bd
dl = bd.Cells(Application.Rows.Count, 1).End(xlUp).Row
Set pl = bd.Range("B2:B" & dl) 'définit la plage pl
 
Range("B2:M" & dl).Select       'Tri BD
    bd.Sort.SortFields.Add Key:=Range("B2"), SortOn _
        :=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With bd.Sort
        .SetRange Range("B2:M" & dl)
        .Apply
    End With
 
bd.Range("A1").AutoFilter Field:=2, Criteria1:="Tiers"      'Filtre1
 On Error Resume Next
    Set dico = CreateObject("Scripting.Dictionary")
    For Each cel In pl.Offset(0, 2).SpecialCells(xlCellTypeVisible)
        dico(cel.Value) = ""
    Next cel
    temp = dico.keys
 
    For i = 0 To UBound(temp)
 
    bd.Range("A1:M" & dl).AutoFilter Field:=2, Criteria1:=Array( _
            "Gzc", "Olc", "Tiers"), Operator:=xlFilterValues                'Filtre2
 
    bd.Range("A1").AutoFilter Field:=4, Criteria1:=temp(i)      'Filtre3
 
        If bd.Range("B:B").SpecialCells(xlCellTypeVisible).Areas(1).Count > 1 Then
              lg = 2
            Else
              lg = bd.Range("B:B").SpecialCells(xlCellTypeVisible).Areas(2).Item(1).Row
        End If
            x = Application.Subtotal(3, [pl])
 
        Set a = Range("B" & Application.Match("Tiers", Range("B1:B" & dl), 0))
        MsgBox a.Address
 
         'concatener
        If x > 1 Then
 
            enObs = Cells(lg, 13) & Chr(10) & "I " & Range(a.Address).Offset(0, 1) & _
            " = " & Range(a.Address).Offset(0, 8) & "mA " & " ; " & Range(a.Address).Offset(0, 13)
            enObs = Replace(enObs, Chr(10) & Chr(10), Chr(10))
            Cells(lg, 13).Value = enObs
            Application.DisplayAlerts = False
            Range(a.Address).Rows.Delete
            Application.DisplayAlerts = True
 
        End If
 
   Next i
 
   bd.Range("A1").AutoFilter
 
MsgBox "Terminé!"
End Sub

Je vous remercie par avance.

Cordialement,
Cathodique

**Daniel.C** · 24/03/2013, 17h41

Bonjour,

Dire que la problématique, c'est bien; dire ce que tu veux exactement, c'est mieux; mieux en tout cas que de poster un code qui ne fonctionne pas. Tu devrais mettre un classeur - sans données complémentaires - en pièce jointe.