XL 2019 Numérotation de cellules avec macro et condition

pat66 · 12 Janvier 2021

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

sylvanu · 12 Janvier 2021

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

sylvanu · 12 Janvier 2021

Bonjour Pat,
Un essai en PJ à tester avec :

VB:

Sub Remplit()
Application.ScreenUpdating = False
Range("A:A").ClearContents
If [B5] = "" Then Exit Sub
For L = 1 To [B5]
    Cells(L, "A") = L
Next L
End Sub

pat66 · 12 Janvier 2021

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

sylvanu · 12 Janvier 2021

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 · 12 Janvier 2021

Merci Sylvanu,

c'est parfait ainsi, un grand merci à toi

Je n'ai plus qu'à trouver l'astuce pour pouvoir afficher les résultats colonne par colonne en cliquant sur le bouton en haut de chaque colonne

merci beaucoup

Pat

sylvanu · 12 Janvier 2021

Dans le fichier il n'y a aucune formule en D5:H25, que sont censés faire ces boutons en haut de colonne ?

pat66 · 12 Janvier 2021

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

sylvanu · 12 Janvier 2021

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

pat66 · 12 Janvier 2021

mais c'est génial

maintenant comment peut on faire pour qu'à l'ouverture du classeur le contenu des cellules de D5 à H25 soient masquées systématiquement ?

pat66 · 12 Janvier 2021

Je crois que j'ai compris, il suffit de vider B5 avec workbook open, n'est ce pas ??

sylvanu · 12 Janvier 2021

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

Staple1600 · 12 Janvier 2021

Bonsoir le fil

J'arrive un peu tard
Mais voici une autre façon de faire (sans boucle)

VB:

Sub Numéroter()
[A:B] = "": [B5] = InputBox("Valeur?", "Test", 15)
[A1] = 1: [A1].Resize([B5]).DataSeries 2, -4132, 1, 1, [B5]
End Sub

pat66 · 13 Janvier 2021

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 · 13 Janvier 2021

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

pat66 · 14 Janvier 2021

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

XL 2019 Numérotation de cellules avec macro et condition

pat66

XLDnaute Impliqué

sylvanu

sylvanu

XLDnaute Barbatruc

Pièces jointes

pat66

XLDnaute Impliqué

Pièces jointes

sylvanu

XLDnaute Barbatruc

Pièces jointes

pat66

XLDnaute Impliqué

sylvanu

XLDnaute Barbatruc

pat66

XLDnaute Impliqué

sylvanu

XLDnaute Barbatruc

Pièces jointes

pat66

XLDnaute Impliqué

pat66

XLDnaute Impliqué

sylvanu

XLDnaute Barbatruc

Pièces jointes

Staple1600

XLDnaute Barbatruc

pat66

XLDnaute Impliqué

sylvanu

XLDnaute Barbatruc

Pièces jointes

pat66

XLDnaute Impliqué

Pièces jointes

Discussions similaires