Microsoft 365 Création d'une suite logique de nombres entiers

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

M92_

XLDnaute Junior
Bonjour à tous,

Mon objectif est : dès que la cellule Bx soit saisie, une valeur numérique Tn (avec n : un entier qui s'incrémente) sera générée dans la cellule Cx.

1623604324339.png


Est-ce que c'est possible de mettre en place un tel fichier, svp ?
Un petit détail : Ce fichier sera mis dans un sharepoint et donc, probablement, il se peut que plus qu'une personne y seront dessus en même temps!

Merci par avance de votre aide.

Cdt,
M92
 

Pièces jointes

Solution
En toute logique il faut aussi empêcher les modifications manuelles en colonne C, fichier (3) :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim tablo, i&, x$, n&
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
If FilterMode Then ShowAllData 'si la feuille est filtrée
With UsedRange.Resize(, 3)
    If Not Intersect(Target, .Columns(3)) Is Nothing Then Application.Undo: GoTo 1 'annule les modifications en colonne C
    tablo = .Value 'matrice, plus rapide
    For i = 2 To UBound(tablo)
        If IsEmpty(tablo(i, 2)) And Not IsEmpty(tablo(i, 3)) Then tablo(i, 3) = ""
        x = CStr(tablo(i, 3))
        If x <> "" Then If Not x Like "T" & String(Len(x) - 1, "#") Then tablo(i, 3) =...
Bonsoir Mes3oud92,

Formule en C2 à tirer vers le bas :
Code:
=REPT("T"&NB.SI(B$1:B2;"><")-1;B2<>"")
A+

Bonsoir @job75,

Merci beaucoup pour votre retour. Il y a un petit soucis !

Dans l'exemple ci-dessous, quand je saisie une valeur pour B5, C5 se met à 'T2' et C10 change de valeur et se met à 'T3'.

Je souhaite plutôt que C10 garde sa valeur (qui est T2 dans ce cas) et B5 se met à 'T3'.

1623614909068.png


Cdt,
M92
 
Voyez le fichier joint et cette macro évènementielle dans le code de la feuille :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i&, x$
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
With UsedRange
    For i = 2 To .Rows.Count
        If IsEmpty(.Cells(i, 2)) And Not IsEmpty(.Cells(i, 3)) Then .Cells(i, 3) = ""
        x = CStr(.Cells(i, 3))
        If x <> "" Then If Not x Like "T" & String(Len(x) - 1, "#") Then .Cells(i, 3) = ""
    Next
    For i = 2 To .Rows.Count
        If Not IsEmpty(.Cells(i, 2)) And IsEmpty(.Cells(i, 3)) Then _
            .Cells(i, 3) = "T" & Application.CountA(.Columns(3))
    Next
End With
Application.EnableEvents = True 'réactive les évènements
End Sub
Elle se déclenche automatiquement quand on modifie ou valide une cellule quelconque.

A+
 

Pièces jointes

Dernière édition:
S'il y a beaucoup de lignes, pour aller plus vite, il faut utiliser un tableau VBA.

Voyez ce fichier (2) et la macro :
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim tablo, i&, x$, n&
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
If FilterMode Then ShowAllData 'si la feuille est filtrée
With UsedRange.Resize(, 3)
    tablo = .Value 'matrice, plus rapide
    For i = 2 To UBound(tablo)
        If IsEmpty(tablo(i, 2)) And Not IsEmpty(tablo(i, 3)) Then tablo(i, 3) = ""
        x = CStr(tablo(i, 3))
        If x <> "" Then If Not x Like "T" & String(Len(x) - 1, "#") Then tablo(i, 3) = ""
    Next
    .Value = tablo '1ère restitution
    n = Application.CountA(.Columns(3))
    For i = 2 To UBound(tablo)
        If Not IsEmpty(tablo(i, 2)) And IsEmpty(tablo(i, 3)) Then _
            tablo(i, 3) = "T" & n: n = n + 1
    Next
    .Value = tablo '2ème restitution
End With
Application.EnableEvents = True 'réactive les évènements
End Sub
Bonne nuit.
 

Pièces jointes

En toute logique il faut aussi empêcher les modifications manuelles en colonne C, fichier (3) :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim tablo, i&, x$, n&
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
If FilterMode Then ShowAllData 'si la feuille est filtrée
With UsedRange.Resize(, 3)
    If Not Intersect(Target, .Columns(3)) Is Nothing Then Application.Undo: GoTo 1 'annule les modifications en colonne C
    tablo = .Value 'matrice, plus rapide
    For i = 2 To UBound(tablo)
        If IsEmpty(tablo(i, 2)) And Not IsEmpty(tablo(i, 3)) Then tablo(i, 3) = ""
        x = CStr(tablo(i, 3))
        If x <> "" Then If Not x Like "T" & String(Len(x) - 1, "#") Then tablo(i, 3) = ""
    Next
    .Value = tablo '1ère restitution
    n = Application.CountA(.Columns(3))
    For i = 2 To UBound(tablo)
        If Not IsEmpty(tablo(i, 2)) And IsEmpty(tablo(i, 3)) Then _
            tablo(i, 3) = "T" & n: n = n + 1
    Next
    .Value = tablo '2ème restitution
End With
1 Application.EnableEvents = True 'réactive les évènements
End Sub
 

Pièces jointes

S'il y a beaucoup de lignes, pour aller plus vite, il faut utiliser un tableau VBA.

Voyez ce fichier (2) et la macro :
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim tablo, i&, x$, n&
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
If FilterMode Then ShowAllData 'si la feuille est filtrée
With UsedRange.Resize(, 3)
    tablo = .Value 'matrice, plus rapide
    For i = 2 To UBound(tablo)
        If IsEmpty(tablo(i, 2)) And Not IsEmpty(tablo(i, 3)) Then tablo(i, 3) = ""
        x = CStr(tablo(i, 3))
        If x <> "" Then If Not x Like "T" & String(Len(x) - 1, "#") Then tablo(i, 3) = ""
    Next
    .Value = tablo '1ère restitution
    n = Application.CountA(.Columns(3))
    For i = 2 To UBound(tablo)
        If Not IsEmpty(tablo(i, 2)) And IsEmpty(tablo(i, 3)) Then _
            tablo(i, 3) = "T" & n: n = n + 1
    Next
    .Value = tablo '2ème restitution
End With
Application.EnableEvents = True 'réactive les évènements
End Sub
Bonne nuit.
Merci beaucoup et bonne journée !

Cdt,
M92
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Retour