XL 2019 Numérotation de cellules avec macro et condition

pat66

XLDnaute Impliqué
Bonjour le forum,
je souhaite pouvoir numéroter un certain nombre de lignes dans la même colonne, voila ce que j'utilise dans un module standard
Sub numero()
For Ctr = 1 To 10
Range("A1:A10")(Ctr) = Ctr
Next
Range("A1:A10").Font.ColorIndex = 1
End Sub

Mais il faudrait que je puisse le faire en inscrivant dans une cellule (ex B5), le nombre de cellules à numéroter, exemple :
B5= 25 , 25 lignes de A1 à A25 se numérotent de 1 à 25
B5= 15 , 15 lignes de A1 à A15 se numérotent de 1 à 15,
Bien sur, les cellules qui étaient remplies par exemple de 16 à 25 se vident ou se remplissent selon la valeur de B5

et enfin si B5 = "", la numérotation disparait c'est à dire que les cellules redeviennent vides

J'espère être clair dans mes propos

un grand merci pour votre aide et votre temps

Pat66
 
Dernière édition:
Solution
Voir PJ. Si B5 > 25 alors on ne fait rien.
VB:
Sub Remplit()
Application.ScreenUpdating = False
Range("A5:A30").ClearContents
If [B5] = "" Or [B5] > 25 Then Exit Sub
For L = 5 To 5 + [B5]
    Cells(L, "A") = L - 4
Next L
End Sub

pat66

XLDnaute Impliqué
Bonjour Sylvanu,

Ta solution correspond bien à ma demande et je t'en remercie,
Je ne te l'avais pas précisé, mais il faudrait l'adapter afin que la numérotation ne démarre qu'à partir de A5 et se termine en A30 et non la colonne entière (j'ai essayé mais pas trouvé ;))
Comme tu peux le voir dans la pièce jointe, à droite il y aura des cellules avec formules de D5 à H25, mais je souhaite afficher le contenu de chaque colonne qu'en cliquant sur le bouton situé en haut de la colonne car j'ai intégré un arrière plan et je ne peux jouer avec les couleurs

Aurais tu une solution ?

merci

Pat
 

Pièces jointes

  • Pat.xlsm
    16.9 KB · Affichages: 4

pat66

XLDnaute Impliqué
A l'ouverture du classeur, je souhaite que le contenu des cellules en D5:H25 soit masqué

et me servir des boutons pour afficher le contenu des lignes en dessous de chaque bouton

Exemple : le bouton situé en D2/D3 doit afficher le contenu de D25 à D30, et ainsi de suite

suis je clair ?

merci
 
Dernière édition:

sylvanu

XLDnaute Barbatruc
Supporter XLD
Just for the fun, un PJ un essai "plus convivial" avec :
VB:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo Fin
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("D2:H2")) Is Nothing Then
        If Target = "Afficher" Then Target = "Masquer" Else Target = "Afficher"
        Cells(3, Target.Column).Select
    End If
Fin:
End Sub
Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("B5")) Is Nothing Then
        Remplit
    End If
End Sub
Sub Remplit()
Application.ScreenUpdating = False
Range("A5:A30").ClearContents
If [B5] = "" Or [B5] > 25 Then Exit Sub
For L = 5 To 5 + [B5]
    Cells(L, "A") = L - 4
Next L
End Sub
 

Pièces jointes

  • Pat3.xlsm
    17.5 KB · Affichages: 5

sylvanu

XLDnaute Barbatruc
Supporter XLD
Exact, mais il faut aussi mettre tous les masquer en place pour être propre :
VB:
Private Sub Workbook_Open()
    Application.ScreenUpdating = False
    Application.EnableEvents = False    ' inhibe les événements comme clic souris
    [B5] = ""
    [A5:A30].ClearContents
    [D2:H2] = "Masquer"
    Application.EnableEvents = True
    Calculate
End Sub
 

Pièces jointes

  • Pat4.xlsm
    18.5 KB · Affichages: 6

pat66

XLDnaute Impliqué
Bonjour le fil,
il est 6 h et bien sur, j'ouvre mon classeur Excel je me mets sur le forum et que vois je ?
des excelliens (j'espère ne pas vous vexer, mais j'aime beaucoup de terme) partageant leurs expertise avec générosité,

Un grand merci, je vais tester tout ça et reviens vers vous

chapeau bas messieurs
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Pat, Staple,
Il y a de la surenchère ici. 😅
Dans la famille "Optimisation", la carte "Suppression de B5"

Il suffit de cliquer dans la matrice rose pour la redimensionner, et dans B4 pour l'effacer.
On gagne du temps car on n'a pas à saisir de valeur de B5.

VB:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo Fin
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("D2:H2")) Is Nothing Then
        If Target = "Afficher" Then Target = "Masquer" Else Target = "Afficher"
        Cells(3, Target.Column).Select
    End If
    If Not Intersect(Target, Range("A5:A30")) Is Nothing Then
        [A5:A30].ClearContents
        For L = 5 To Target.Row
            Cells(L, "A") = L-4
        Next L
    End If
    If Not Intersect(Target, Range("A4")) Is Nothing Then
        [A5:A30].ClearContents
    End If
Fin:
End Sub
 

Pièces jointes

  • Pat5.xlsm
    18.5 KB · Affichages: 3
Dernière édition:

pat66

XLDnaute Impliqué
Bonjour Le fil,
Bonjour Sylvanu
Très intéressant ton post #14, mais la solution avec la possibilité de saisir en AE5 est mieux adaptée, encore merci

Cependant j'ai un problème de compatibilité car dans mon classeur j'utilise déjà "Worksheet_SelectionChange(ByVal Target As Range)" et en ajoutant ton code je me retrouve avec des anomalies.
Aurais tu la gentillesse d'y jeter un coup d'oeil afin de rendre tout cela opérationnel

Ci joint le classeur avec les bonnes cellules et le code 'en commentaire à mélanger dans "Sub Worksheet_SelectionChange(ByVal Target As Range)" avec le tien

D'avance je te remercie pour tout

belle journée à tous

Pat
 

Pièces jointes

  • Pat6.xlsm
    23.4 KB · Affichages: 3

Discussions similaires