Autres (RESOLU)incrémentations automatique sans formule

chaelie2015 · 9 Février 2022

Bonjour
je souhaite dans mon tableau (commence de A2 ) incrémenter la cellule ( de la colonne A) automatiquement par vb si la cellule adjacente ( colonne B) est différente de vide
si B2 (colonne B) est <>"" alors afficher dans A2=1
si B3 (colonne B) est <>"" alors afficher dans A3=2
anis de suite....
a+

Phil69970 · 9 Février 2022

Bonjour @chaelie2015

Je te propose

VB:

Sub Numero()
Application.ScreenUpdating = False
Dim Derlig&
Derlig = Worksheets("Feuil1").Range("B" & Rows.Count).End(xlUp).Row
[A2] = 1: Range("A2:A" & Derlig).DataSeries
End Sub

*Merci de ton retour

@Phil69970

Phil69970 · 9 Février 2022

Bonjour @chaelie2015

Je te propose

VB:

Sub Numero()
Application.ScreenUpdating = False
Dim Derlig&
Derlig = Worksheets("Feuil1").Range("B" & Rows.Count).End(xlUp).Row
[A2] = 1: Range("A2:A" & Derlig).DataSeries
End Sub

*Merci de ton retour

@Phil69970

job75 · 9 Février 2022

Bonjour chaelie2015, Phil69970,

Essayez ceci :

VB:

Sub Incrementer()
With ActiveSheet
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    With .Range("A2:B" & .Cells.SpecialCells(xlCellTypeLastCell).Row)
        If .Row < 2 Then Exit Sub
        .Columns(1) = "=IF(RC[1]="""","""",MAX(R1C:R[-1]C)+1)"
        .Columns(1) = .Columns(1).Value 'supprime les formules
    End With
End With
End Sub

A+

chaelie2015 · 9 Février 2022

Bonjour @Phil69970, Job
Merci pour les réponses , c'est parfait
a+

chaelie2015 · 14 Septembre 2022

Bonjour Forum,@Phil69970,job
je souhaite utiliser ce code automatiquement sans passer par bouton
c'est fait par "Private Sub Worksheet_SelectionChange(ByVal Target As Range)"
le souci par exemple si je supprime le contenu de la cellule C2 automatiquement la cellule A2 DOIT ETRE VIDE

VB:

Application.ScreenUpdating = False
Dim Derlig&
Derlig = Worksheets("Feuil1").Range("C" & Rows.Count).End(xlUp).Row
[A2] = 1: Range("A2:A" & Derlig).DataSeries

merci

Autres (RESOLU)incrémentations automatique sans formule

chaelie2015

XLDnaute Accro

Phil69970

Phil69970

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

chaelie2015

XLDnaute Accro

chaelie2015

XLDnaute Accro

Pièces jointes

Discussions similaires