avant dernière cellule d'une colonne filtrée

**orgnobi** · 29/08/2012, 10h21

Bonjour à tous,

j'aimerais savoir s'il y a une possibilité de sélectionner l'avant dernière cellule d'une colonne filtrée auparavant.
Pour la dernière cellule de la colonne filtrée le Cells(a, b).End(xlUp).Value = fonctionne très bien.
Par contre le offset (-1,0) ne tient pas en compte du filtre.

J'ai essayé de trouver la solution sur le net en vain.
Si quelqu'un peut m'aider. (je travaille sur excel 2003).

voici ce que j'ai fais (juste une partie):

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
Case 25, 26
 
            a2 = Cells(65536, 78).End(xlUp).Value
 
                If a2 = 1 Then
 
                    MsgBox (a2)
 
                    Range("CA3:CA65536").SpecialCells(xlVisible).Value = 1073             ' prendre 1 câble 12 paires
                    Range("CB3:CB65536").SpecialCells(xlVisible).Value = "1SAU11101CAM"   ' écrit le numéro du câble
 
                    Cells(65536, 79).End(xlUp).Value = 1070
                    Cells(65536, 80).End(xlUp).Value = "1SAU11102CAM"
 
                Else
 
                    MsgBox (a2)
 
                    Range("CA3:CA65536").SpecialCells(xlVisible).Value = 1073               'prendre un câble 12 paires
                    Range("CB3:CB65536").SpecialCells(xlVisible).Value = "1SAU11101CAM"     'écrit le numéro du câble
 
                    Range("CA65536").End(xlUp).Offset(-1, 0).Value = 1070                   'prendre un câble 1 paire (pb)
                    Range("CB65536").End(xlUp).Offset(-1, 0).Value = "1SAU11102CAM"         'écrit le numéro du câble (pb)
 
                    Cells(65536, 79).End(xlUp).Value = 1070                                 'prendre un câble 1 paire
                    Cells(65536, 80).End(xlUp).Value = "1SAU11102CAM"                       'écrit le numéro du câble
 
                End If
 
 
    End Select
 
 
End Sub

**mercatog** · 29/08/2012, 19h31

Une fonction qui permet de retourner l'avant dernière ligne remplie (avec ou sans filtre)

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
Function AvantDerniereLigne(ByVal Rng As Range) As Long
Dim Str As String
Dim Tb
 
Str = Union(Rng.SpecialCells(xlCellTypeConstants), Rng.SpecialCells(xlCellTypeFormulas)).SpecialCells(xlCellTypeVisible).Address
Tb = Split(Str, ":")
Str = Tb(UBound(Tb))
If InStr(Str, ",") Then
    Tb = Split(Str, ",")
    AvantDerniereLigne = Val(Split(Tb(UBound(Tb) - 1), "$")(2))
Else
    AvantDerniereLigne = Val(Split(Tb(UBound(Tb)), "$")(2)) - 1
End If
AvantDerniereLigne = Application.Max(AvantDerniereLigne, 1)
End Function

Pour test

Code :

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

1
2
3
4
Sub Test()
 
MsgBox AvantDerniereLigne(Worksheets("Feuil1").Range("A:A"))
End Sub

**orgnobi** · 30/08/2012, 11h28

Bonjour Mercatog,

Déjà un merci de ta réponse.
Je l'ai testé avec tes paramètres et cela fonctionne. Donc super.
J'ai essayé de l'adapter avec mes paramètres et là j'ai une erreur :

Erreur d'exécution '1004' : Pas de cellules correspondantes.
L'erreur est sur la première ligne de la fonction 'avantderniereligne'.

Voilà mon code (en entier cette fois-ci) :

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
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
Sub panneaux1div1SAUinstrum()


'
    Selection.AutoFilter Field:=17, Criteria1:="E"              'filtre sur la révision
    Selection.AutoFilter Field:=65, Criteria1:="KSC0111PP-"     ' filtre sur le panel
    Selection.AutoFilter Field:=37, Criteria1:="SAU"            ' filtre le système
    Selection.AutoFilter Field:=35, Criteria1:="Div1"           ' filtre sur la division
    Selection.AutoFilter Field:=6, Criteria1:="instrum"         ' filtre sur le type de signal

'variables
Dim a1 As Integer
Dim a2 As Integer
Dim ligne As Long



a1 = Application.Subtotal(9, [BZ:BZ]) 'total des brins de la colonne BZ des cellules filtrées


    Select Case a1

        Case 1, 2
        
            Range("CA3:CA65536").SpecialCells(xlVisible).Value = 1070                 ' prendre un cable 1 Paire
            Range("CB3:CB65536").SpecialCells(xlVisible).Value = "1SAU11101CAM"       ' écrit le numéro du câble
            
        Case 3, 4
        
            Range("CA3:CA65536").SpecialCells(xlVisible).Value = 1071                 ' prendre un cable 2 Paires
            Range("CB3:CB65536").SpecialCells(xlVisible).Value = "1SAU11101CAM"       ' écrit le numéro du câble
            
        Case 4 To 12
        
            Range("CA3:CA65536").SpecialCells(xlVisible).Value = 1072                 ' prendre un cable 6 Paires
            Range("CB3:CB65536").SpecialCells(xlVisible).Value = "1SAU11101CAM"       ' écrit le numéro du câble
            
        Case 13 To 24
        
            Range("CA3:CA65536").SpecialCells(xlVisible).Value = 1073                 ' prendre un cable 12 Paires
            Range("CB3:CB65536").SpecialCells(xlVisible).Value = "1SAU11101CAM"       ' écrit le numéro du câble
            
        Case 25, 26
                               
            a2 = Cells(65536, 78).End(xlUp).Value
           
                If a2 = 1 Then
                    
                    MsgBox (a2)
                    
                    Range("CA3:CA65536").SpecialCells(xlVisible).Value = 1073             ' prendre 1 câble 12 paires
                    Range("CB3:CB65536").SpecialCells(xlVisible).Value = "1SAU11101CAM"   ' écrit le numéro du câble
                    
                    Cells(65536, 79).End(xlUp).Value = 1070
                    Cells(65536, 80).End(xlUp).Value = "1SAU11102CAM"
                    
                Else
                    
                    MsgBox (a2)
                                                      
                                      
                    Range("CA3:CA65536").SpecialCells(xlVisible).Value = 1073               'prendre un câble 12 paires
                    Range("CB3:CB65536").SpecialCells(xlVisible).Value = "1SAU11101CAM"     'écrit le numéro du câble
                    
                    ligne = AvantDerniereLigne(Worksheets("Database").Range("BZ:BZ"))     ' adaptation du code de Mercatog
                    
                    Range("CA", "& ligne") = 1070                                           'prendre un câble 1 paire (Problème)
                    Range("CB", "& ligne") = "1SAU11102CAM"                                 'écrit le numéro du câble (Problème)
                                                          
                      
                    Cells(65536, 79).End(xlUp).Value = 1071                                 'prendre un câble 1 paire
                    Cells(65536, 80).End(xlUp).Value = "1SAU11103CAM"                       'écrit le numéro du câble
                    
                End If
            
                       
    End Select


End Sub
Function AvantDerniereLigne(ByVal Rng As Range) As Long
Dim Str As String
Dim Tb
 
Str = Union(Rng.SpecialCells(xlCellTypeConstants), Rng.SpecialCells(xlCellTypeFormulas)).SpecialCells(xlCellTypeVisible).Address      ' ligne surligné en jaune par le débogage...
Tb = Split(Str, ":")
Str = Tb(UBound(Tb))
If InStr(Str, ",") Then
    Tb = Split(Str, ",")
    AvantDerniereLigne = Val(Split(Tb(UBound(Tb) - 1), "$")(2))
Else
    AvantDerniereLigne = Val(Split(Tb(UBound(Tb)), "$")(2)) - 1
End If
AvantDerniereLigne = Application.Max(AvantDerniereLigne, 1)
End Function

Vois-tu l'erreur que j'ai commise dans ce code ?

Cordialement,
Orgnobi

**mercatog** · 01/09/2012, 10h19

Il Fallait écrire

Code :

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

1
2
Range("CA"& ligne) = 1070                                           'prendre un câble 1 paire (Problème)
Range("CB"& ligne) = "1SAU11102CAM"

Sinon, pour ton code, évites de travailler avec Selection, de travailler avec l'ensemble des lignes de la feuille même ceux non utilisés et sans indiquer à quelle feuille appartiennent les ranges.

Ton code pourrait être écrit comme ceci (Des adaptations peut être sont nécessaires)

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
 
Sub Panneaux1div1SAUinstrum()
Dim A1 As Integer, A2 As Integer
Dim LastLig As Long, Ligne As Long
 
Application.ScreenUpdating = False
With Worksheets("Database")
    .AutoFilterMode = False
    LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row    '>>>ICI ADAPTE A LA COLONNE QUI PERMET DE TROUVER LA DERNIERE LIGNE
    With .Range("A2:BM" & LastLig)
        .AutoFilter Field:=17, Criteria1:="E"      'filtre sur la révision
        .AutoFilter Field:=65, Criteria1:="KSC0111PP-"    ' filtre sur le panel
        .AutoFilter Field:=37, Criteria1:="SAU"    ' filtre le système
        .AutoFilter Field:=35, Criteria1:="Div1"   ' filtre sur la division
        .AutoFilter Field:=6, Criteria1:="instrum"    ' filtre sur le type de signal
    End With
    If .Range("A2:A" & LastLig).SpecialCells(xlVisible).Count > 1 Then
        A1 = Application.Subtotal(9, .[BZ:BZ])     'total des brins de la colonne BZ des cellules filtrées
 
        .Range("CB3:C" & LastLig).SpecialCells(xlVisible).Value = "1SAU11101CAM"    ' écrit le numéro du câble
        Select Case A1
            Case 1, 2
                .Range("CA3:CA" & LastLig).SpecialCells(xlVisible).Value = 1070    ' prendre un cable 1 Paire
            Case 3, 4
                .Range("CA3:CA" & LastLig).SpecialCells(xlVisible).Value = 1071    ' prendre un cable 2 Paires
            Case 4 To 12
                .Range("CA3:CA" & LastLig).SpecialCells(xlVisible).Value = 1072    ' prendre un cable 6 Paires
            Case 13 To 26
                .Range("CA3:CA" & LastLig).SpecialCells(xlVisible).Value = 1073    ' prendre un cable 12 Paires
                If A1 > 24 Then                    '25, 26
                    A2 = .Cells(.Rows.Count, 78).End(xlUp).Value
                    If A2 = 1 Then
                        .Cells(.Rows.Count, 79).End(xlUp).Value = 1070
                        .Cells(.Rows.Count, 80).End(xlUp).Value = "1SAU11102CAM"
                    Else
                        Ligne = AvantDerniereLigne(.Range("BZ:BZ"))    ' adaptation du code de Mercatog
                        .Range("CA" & Ligne) = 1070    'prendre un câble 1 paire (Problème)
                        .Range("CB" & Ligne) = "1SAU11102CAM"    'écrit le numéro du câble (Problème)
                        .Cells(.Rows.Count, 79).End(xlUp).Value = 1071    'prendre un câble 1 paire
                        .Cells(.Rows.Count, 80).End(xlUp).Value = "1SAU11103CAM"    'écrit le numéro du câble
                    End If
                End If
        End Select
    Else
        MsgBox "Plage filtrée vide"
    End If
End With
End Sub

**orgnobi** · 10/09/2012, 11h51

Merci de tes réponses.

Je viens juste de rentrer de vacances, j'ai donc beaucoup de travail en retard, urgent et pour hier.
Comme un peu tout le monde en rentrant de vacances, en fait.
Je testerai donc tes 2 solutions quand j'aurai un peu plus de temps.

Orgnobi

avant dernière cellule d'une colonne filtrée

Macros et VBA Excel

Discussions similaires

Partager

Partager