Répéter une macro à valeur aléatoire en fonction d'une InputBox

Version imprimable

Bonjour à tous,

Voilà, mon objectif est de répéter une macro préalablement inscrite (qui génère des valeurs aléatoires) sur un nombre défini dans une InputBox.

Simplement, je voudrais copier coller une macro qui génère des valeurs aléatoires sur la plage "B2:B7", une colonne sur deux à droite, en fonction d'un nombre inscrit dans une inputbox.

Voici ma macro qui génère les valeurs aléatoirement en "B2:B7" et qu'il faut exécuter une colonne sur deux vers la droite jusqu'au nombre que j’inscris dans mon input box qui apparaît au départ :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 Const plage = "B2:B7" Const total = 100 Const mini = 0 Const maxi = 100 Sub thib() i = InputBox("nombre de simulation") Dim n As Long, tot As Long, a As Long, k As Long, d As Long, T If Range(plage).Columns.Count > 1 Then Exit Sub n = Range(plage).Cells.Count ReDim T(1 To n) tot = 0 For k = 1 To n a = mini + Int((maxi - mini + 1) * Rnd) tot = tot + a T(k) = a Next k If tot < total Then d = total - tot For k = 1 To d a = 1 + Int(n * Rnd) If T(a) < maxi Then T(a) = T(a) + 1 Else k = k - 1 End If Next k ElseIf tot > total Then d = tot - total For k = 1 To d a = 1 + Int(n * Rnd) If T(a) > mini Then T(a) = T(a) - 1 Else k = k - 1 End If Next k End If Range(plage) = Application.Transpose(T) End Sub
SI quelqu'un pouvait me dépanner..... je suis encore que débutant....

Un grand merci à vous,
A+

Bonjour,

Avant de te répondre, je te recommande fortement d'indenter ton code pour en améliorer la lisibilité.

Tu trouveras ci-dessous une proposition qui devrait résoudre ton problème :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
Const plage = "B2:B7"
Const total = 100
Const mini = 0
Const maxi = 100
 
Option Explicit
 
Sub thib()
 
 
    Dim n As Long, tot As Long, a As Long, k As Long, d As Long, T() As Integer
    Dim i As Long
    Dim ColonneOffset As Long
 
    Application.Calculation = xlCalculationManual
 
    i = InputBox("nombre de simulation")
    If Range(plage).Columns.Count > 1 Then Exit Sub
 
    For ColonneOffset = 0 To i
        n = Range(plage).Cells.Count
        ReDim T(1 To n)
        tot = 0
        For k = 1 To n
            a = mini + Int((maxi - mini + 1) * Rnd)
            tot = tot + a
            T(k) = a
        Next k
        If tot < total Then
            d = total - tot
            For k = 1 To d
                a = 1 + Int(n * Rnd)
                If T(a) < maxi Then
                    T(a) = T(a) + 1
                Else
                    k = k - 1
                End If
            Next k
        ElseIf tot > total Then
            d = tot - total
            For k = 1 To d
                a = 1 + Int(n * Rnd)
                If T(a) > mini Then
                    T(a) = T(a) - 1
                Else
                    k = k - 1
                End If
            Next k
        End If
        Range(plage).Offset(0, ColonneOffset * 2) = Application.Transpose(T)
    Next ColonneOffset
    Application.Calculation = xlCalculationAutomatic
End Sub

Poulpe

30/08/2019, 10h51
skyroz41

Grand merci

Bonjour Mr POULPE,

Je vous suit très reconnaissant pour cette réponse rapide !! Votre code fonctionne comme demander !!! Je prend note de votre conseil à l'avenir !!
Encore une fois merci à vous et bonne suite,

Sky