XL 2013 Tableau automatique rempli en statistique

gecanosaga

XLDnaute Nouveau
Bonjour à tous !

J'aimerai réaliser un remplissage d'un nombre donné de cellules par des "0" et des "1" en fonction d'un paramètre d'entré qui donne le pourcentage de "1" dans ce tableau.

Ex : si je veux 33% de "1" dans 6 cellules, il devra me remplir les 6 cellules avec 4 "0" et 2 "1" réparti de manière homogène :

001001

les dieux du VBA peuvent ils m'aider ? ;)
 

CPk

XLDnaute Impliqué
Re : Tableau automatique rempli en statistique

Bonjour à toutes et à tous.

Je rejoins l'avis de job75 sur l'importance des paramètres pour avoir une homogénéité.
En attendant...Je propose un bout de code (exploitable ? améliorable ?) qui tend vers la cible avec ses limites.

Code:
Sub répartition()    
Feuil1.Rows(4).ClearContents
    Dim p%, b()
    p = (Feuil1.[A2] * 100)
    c = Round(Feuil1.[B2] / 2)
    cc = Application.WorksheetFunction.RoundUp(c * p / 100, 0.5)
    ReDim b(c - 1)
    For a = 1 To c
        If a <= c - cc Then
            b(a - 1) = 0
        Else
            b(a - 1) = 1
        End If
    Next
    Feuil1.Cells(4, 1).Resize(1, UBound(b) + 1) = b
    Feuil1.Cells(4, c + 1).Resize(1, UBound(b) + 1) = b


End Sub

Le principe et de créer un motif fait de {1.0} sur la moitié d'un segment (1 segment = nb de colonne) et de recopier se motif pour avoir une homogénéïté...
 

Pièces jointes

  • Classeur1.xlsm
    16 KB · Affichages: 59
  • Classeur1.xlsm
    16 KB · Affichages: 53
Dernière modification par un modérateur:

job75

XLDnaute Barbatruc
Re : Tableau automatique rempli en statistique

Bonjour,

Je repasse par ici avec une barre de progression, au cas où :

Code:
Private Sub worksheet_Change(ByVal Target As Range)
Label1.Visible = False: Label2.Visible = False
If TypeName(Evaluate([B2].Text)) <> "Range" Or [C2] = "" Then Exit Sub
With Evaluate([B2].Text)
  Label1.Top = .Top
  Label1.Left = .Left
  Label1.Height = IIf([C2] = "Horizontal", .Height, [A2] * .Height)
  Label1.Width = IIf([C2] = "Horizontal", [A2] * .Width, .Width)
  Label2.Top = IIf([C2] = "Horizontal", .Top, .Top + Label1.Height)
  Label2.Left = IIf([C2] = "Horizontal", .Left + Label1.Width, .Left)
  Label2.Height = IIf([C2] = "Horizontal", .Height, .Height - Label1.Height)
  Label2.Width = IIf([C2] = "Horizontal", .Width - Label1.Width, .Width)
  Label1.Visible = True: Label2.Visible = True
End With
End Sub
Bonne soirée.
 

Pièces jointes

  • Barre de progression(1).xlsm
    21.5 KB · Affichages: 50
Dernière édition:

job75

XLDnaute Barbatruc
Re : Tableau automatique rempli en statistique

Bonjour gecanosaga, CPk, le forum,

J'ai quand même étudié cette affaire de 0 et de 1.

Voyez le fichier joint et cette macro dans le code de la feuille :

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A2:B2]) Is Nothing Then Exit Sub
Dim nb1%, nb0%, nb%, vbase, v, pas%, a(), i%, j%, n%
Application.ScreenUpdating = False
Columns(3).Resize(, Columns.Count - 2).ClearContents 'RAZ
If TypeName(Evaluate([B2].Text)) <> "Range" Then Exit Sub
With Range([B2])
  If .Column < 3 Or .Rows.Count > 1 Then Exit Sub
  nb1 = Round([A2] * .Count) 'nombre de 1
  nb0 = .Count - nb1 'nombre de 0
  nb = IIf(nb1 <= nb0, nb1, nb0)
  vbase = IIf(nb1 <= nb0, 0, 1)
  v = IIf(nb1 <= nb0, 1, 0)
  If nb Then pas = Int(.Count / nb)
  ReDim a(1 To .Count) 'matrice-vecteur, plus rapide
  '---positionnement des valeurs vbase et v---
  For i = 1 To UBound(a)
    j = j + 1
    a(i) = vbase
    If j = pas And n < nb Then a(i) = v: n = n + 1: j = 0
  Next
  '---restitution---
  .Value = a
End With
With Me.UsedRange: End With 'actualise les barres de défilement
End Sub
La vraie difficulté résidait dans le fait qu'il fallait "répartir de manière homogène".

La méthode que j'utilise est la suivante :

- quand le nombre de 1 est inférieur ou égal au nombre de 0 ce sont les 1 qui déterminent le pas et sont positionnés

- quand le nombre de 1 est supérieur au nombre de 0 ce sont les 0 qui déterminent le pas et sont positionnés.

Bonne journée.
 

Pièces jointes

  • Statistiques(1).xlsm
    20.5 KB · Affichages: 35
Dernière édition:

job75

XLDnaute Barbatruc
Re : Tableau automatique rempli en statistique

Re,

La solution précédente est bonne pour un nombre peu important de colonnes.

Pour un grand nombre de colonnes il vaut beaucoup mieux procéder par tirages aléatoires.

L'homogénéité se fait par la loi des grands nombres.

Voyez ce fichier (2) et la macro du bouton :

Code:
Private Sub CommandButton1_Click()
Dim pct#, ncol%, P As Range, nb1%, a%(), n%, i%
pct = [A2]: ncol = [B2]
Set P = [D2].Resize(, ncol) '1ère cellule à adapter
nb1 = Round(ncol * pct) 'nombre de 1 à obtenir
Randomize
1 ReDim a(1 To ncol) 'matrice-vecteur, plus rapide
n = 0
'---tirages aléatoires---
For i = 1 To ncol
  If Rnd < pct Then
    a(i) = 1
    n = n + 1
  Else
    a(i) = 0
  End If
Next
If n <> nb1 Then GoTo 1
'---restitution---
P = a
i = Columns.Count - P.Column - ncol + 1
If i Then P(1, ncol + 1).Resize(, i).ClearContents
With Me.UsedRange: End With 'actualise la barre de défilement horizontale
End Sub
A+
 

Pièces jointes

  • Statistiques(2).xlsm
    75.5 KB · Affichages: 41

CPk

XLDnaute Impliqué
Re : Tableau automatique rempli en statistique

Bonjour Job75. Ca fait bobo à la tête la théorie des grands nombres mais ça à le mérite de me préparer pour mon test d'évaluation preformatif jeudi prochain. Si j'ai bien tout compris (donc propos avec réserve) la théorie des grands nombre permet de quantifier le % de 1 sur un segment toute proportion gardée. Mais dans ton exemple, tu gardes l'intégralité du nombre de colonne donc quelque part on ne pourra jamais avoir une homogénéité, ne faudrait-il pas au minimum diviser par deux le nombre de colonne et de répartir le % de 1 sur un segment de (n) colonne /2 ? (je sais pas si je suis clair dans mes explications...)
 
Dernière modification par un modérateur:

job75

XLDnaute Barbatruc
Re : Tableau automatique rempli en statistique

Bonjour CPk, le forum,

Avec des tirages aléatoires il n'y a rien à faire d'autre que de générer des nombres aléatoires :

Code:
If Rnd < pct Then
Et plus l'échantillon (la plage) est grand meilleur est le résultat.

Bonne journée.
 

job75

XLDnaute Barbatruc
Re : Tableau automatique rempli en statistique

Re,

Il faut bien comprendre que sur ma macro du post #8 il y a GoTo 1 qui permet de boucler jusqu'à ce que le nombre de 1 (le pourcentage exact) soit atteint.

Le pourcentage exact est donc atteint sur 16381 cellules, mais bien sûr il ne sera pas atteint sur les plages de dimension inférieure.

C'est pour montrer cela que j'étudie des plages de 1000 colonnes...

A+
 

Discussions similaires

  • Résolu(e)
Microsoft 365 Macro VBA
Réponses
16
Affichages
3 K

Statistiques des forums

Discussions
314 223
Messages
2 107 498
Membres
109 844
dernier inscrit
odyn