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

M92_ · 13 Juin 2021

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.

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

job75 · 14 Juin 2021

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) =...

job75 · 13 Juin 2021

Bonsoir Mes3oud92,

Formule en C2 à tirer vers le bas :

Code:

=REPT("T"&NB.SI(B$1:B2;"><")-1;B2<>"")

A+

M92_ · 13 Juin 2021

job75 à dit:
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'.

Cdt,
M92

job75 · 13 Juin 2021

Pour faire cela il faut du VBA, essayez, c'est un bon exercice.

M92_ · 13 Juin 2021

job75 à dit:
Pour faire cela il faut du VBA, essayez, c'est un bon exercice.

D'accord !
Je suis assez novice en VBA, une piste ? Merci.

job75 · 13 Juin 2021

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+

job75 · 14 Juin 2021

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.

job75 · 14 Juin 2021

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

M92_ · 14 Juin 2021

job75 à dit:

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

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

M92_

XLDnaute Junior

Pièces jointes

job75

job75

XLDnaute Barbatruc

Pièces jointes

M92_

XLDnaute Junior

job75

XLDnaute Barbatruc

M92_

XLDnaute Junior

job75

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

M92_

XLDnaute Junior

Discussions similaires