XL 2016 VBA Table Incrémentée

james7734 · 23 Mai 2021

Bonjour à tous,

Je tente de créer une table incrémenté en VBA, c'est à dire à générer les données en colonne E (de la pj) en VBA. Sachant que la cellule E2 représente le minimum (cellule O1 et que la colonne E devrait s'arrêter au "max" en cellule O2, avec un incrément de la cellule O3. Je ne sais pas trop comment m'y prendre mais je souhaites absolument un code VBA car il fera partie d'un code plus global.

Merci de votre aide!

sylvanu · 23 Mai 2021

Bonjour James,
Un essai en PJ avec :

VB:

Sub Incrementer()
    Dim DL%, i%, Liste, Min, Max, Inc
    Application.ScreenUpdating = False  ' Fige écran
    DL = Range("E65500").End(xlUp).Row  ' Dernière cellule occupée de E
    Range("E2:E" & DL).ClearContents    ' Effacement col E
    Min = [O1]: Max = [O2]: Inc = [O3]  ' Acquisition paramètres
    Qty = 1 + Int((Max - Min) / Inc)    ' Détermination Nb élements
    ReDim Liste(Qty + 1)                ' Dimmensionnement array
    For i = 0 To Qty                    ' remplissage array
        Liste(i) = Min + i * Inc
    Next i
    ' Restitution valeurs array dans col E
    Range("$E$2").Resize(Qty, 1).Value = Application.Transpose(Liste)
End Sub

sylvanu · 23 Mai 2021

Bonjour James,
Un essai en PJ avec :

VB:

Sub Incrementer()
    Dim DL%, i%, Liste, Min, Max, Inc
    Application.ScreenUpdating = False  ' Fige écran
    DL = Range("E65500").End(xlUp).Row  ' Dernière cellule occupée de E
    Range("E2:E" & DL).ClearContents    ' Effacement col E
    Min = [O1]: Max = [O2]: Inc = [O3]  ' Acquisition paramètres
    Qty = 1 + Int((Max - Min) / Inc)    ' Détermination Nb élements
    ReDim Liste(Qty + 1)                ' Dimmensionnement array
    For i = 0 To Qty                    ' remplissage array
        Liste(i) = Min + i * Inc
    Next i
    ' Restitution valeurs array dans col E
    Range("$E$2").Resize(Qty, 1).Value = Application.Transpose(Liste)
End Sub

Dranreb · 23 Mai 2021

Bonjour
Sous forme de Sub pour pouvoir l'utiliser de plusieurs endroits, comme vous laissez entendre que ça vous servira :

VB:

Option Explicit
Sub test()
   With ActiveSheet
      ListeIncrémentée .[E2], .[O1].Value, .[O2].Value, .[O3].Value
      End With
   End Sub
Sub ListeIncrémentée(ByVal RngCible As Range, ByVal Mini As Double, ByVal Maxi As Double, ByVal Pas As Double)
   Set RngCible = RngCible.Resize(Int((Maxi - Mini) / Pas + 1), 1)
   RngCible.FormulaR1C1 = "=(ROW()-" & RngCible.Row() & ")*" & Trim$(Str$(Pas)) & "+" & Trim$(Str$(Mini))
   End Sub

james7734 · 23 Mai 2021

Les deux solutions me conviennent très bien, merci bcp à vous deux!

XL 2016 VBA Table Incrémentée

james7734

XLDnaute Junior

Pièces jointes

sylvanu

sylvanu

XLDnaute Barbatruc

Pièces jointes

Dranreb

XLDnaute Barbatruc

james7734

XLDnaute Junior

Discussions similaires