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

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

  • Classeur1_SuiteLogique.xlsx
    9.6 KB · Affichages: 13
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) =...

M92_

XLDnaute Junior
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
 

job75

XLDnaute Barbatruc
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

  • VBA_SuiteLogique(1).xlsm
    17.9 KB · Affichages: 3
Dernière édition:

job75

XLDnaute Barbatruc
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

  • VBA_SuiteLogique(2).xlsm
    18.7 KB · Affichages: 5

job75

XLDnaute Barbatruc
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

  • VBA_SuiteLogique(3).xlsm
    19.4 KB · Affichages: 2

M92_

XLDnaute Junior
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
 

Statistiques des forums

Discussions
315 098
Messages
2 116 189
Membres
112 679
dernier inscrit
Yupanki