Discussion :

[emarnolydia]

Salut à tous,

Malheureusement je n’arrive pas à faire ce que je souhaite. Donc voici mes explications.

L'action que je veux que se trouve sur la feuille "Echantillon analyse".

Ce que j'ai :
• Une valeur d'échantillon C1.
• A partir de celle-ci, j'ai une valeur donnée en A3, aléatoire, par rapport à mon tableau "Tableau 1", qui est dans l'onglet "Rapport 1".
o Attention, la valeur aléatoire bouge, si des valeurs, de mon classeur en entier, sont changées.
o C'est pour ça que j'ai créé la colonne B, qui est le fruit d'un copié de la colonne A, et dont je colle les valeurs (et pas la fonction) dans la colonne B
• Les colonnes C, D et E travaillent donc avec la valeur fixe, de la colonne B
• Et je tire vers le bas manuellement, la ligne A3:E3 pour avoir le même nombre de ligne que la valeur de mon échantillon C1.

Ce que je souhaite :
• Créer un bouton sur la feuille
• Je veux qu'en cliquant sur le bouton, un nombre de ligne A:E correspondant à la valeur de l'échantillon soient créées.
• La valeur aléatoire qui ressort en A, est une valeur de "Tableau 1[Code OEIE]
o Attention, je voudrais que les valeurs soient uniquement celle qui ont une valeur dans "Tableau 1[Date d'archivage de la DOC]".

Possibilité d'un bouton RAZ, pour supprimer les lignes créées, avant de relancer une création au prochain échantillon.

Merci à vous


Je vous souhaite tous mes vœux pour la nouvelle année.

[deedolith]

J'ai pas compris:

• Je veux qu'en cliquant sur le bouton, un nombre de ligne A:E correspondant à la valeur de l'échantillon soient créées.

Dans ton exemple precis ou l'echantillon (C1) vaut 116, tu veux créer 116 lignes ?

[emarnolydia]

Bonjour,

en effet, oui 116, avec les conditions citées.

[geogeo70]

bonsoir,
j'ai essayé de comprendre votre fichier...

Je supprime toutes les lignes sauf la 1ere.
Mon idée est de recopier la première ligne, coller en dessous et vérifier si date <>0 et itérer sur l'ensemble des valeurs.

J'installe un bouton sur la feuille pour lancer une nouvelle liste aléatoire

Il faudrait en plus vérifier si en 1ere ligne la date est vide... à vous de le faire!...

le code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub newligne()
 
Dim fechant As Worksheet, rap As Worksheet
Dim echant As Range, c As Range, rdate As Range
Dim ligne As Integer, der As Integer
Dim archi As Date
 
Application.ScreenUpdating = False
 
Set rap = Worksheets("Rapport 1") 'pour les dates
Set fechant = Worksheets("Echantillon analyse")
Set echant = fechant.Range(fechant.Range("A4"), fechant.Range("A4").End(xlDown))
der = echant.Count
echant = Range(fechant.Cells(1, 1), fechant.Cells(der, 5))
echant.Clear 'effacement des lignes en gardant la première
 
Set echant = fechant.Range("A3:E3") '1ère ligne
fechant.Range("A3").Select
fechant.Range("A3").Copy
fechant.Range("A3").Calculate
 
fechant.Range("B3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False 'copy du 1er alea
For ligne = 4 To fechant.Cells(1, 3).Value + 2 'parcours des lignes
  'copie de ligne
  With echant
    .Copy
    fechant.Range("A" & CStr(ligne)).Select
    fechant.Paste 'copy ligne
    Application.CutCopyMode = False
    fechant.Range("A" & CStr(ligne)).Copy 'copy alea
    fechant.Range("B" & CStr(ligne)).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
  End With
 
  'élimination des dates vides
  der = rap.Range(rap.Range("D2"), rap.Range("D2").End(xlDown)).Count + 1
  Set rdate = Range(rap.Cells(2, 4), rap.Cells(der, 8))
  archi = Application.WorksheetFunction.VLookup(fechant.Cells(ligne, 2), rdate, 5, VRAI)
  If archi = 0 Then ligne = ligne - 1
Next ligne
Application.CutCopyMode = False
 
Application.ScreenUpdating = True
Application.Calculate
End Sub

Je vous joins mon travail...

TMJD_QRMJDessai.xlsm

à vous...

a+

geogeo70

[emarnolydia]

Super, merci beaucoup à vous, cela correspond fortement à ce que je souhaite.
Je vais essayer d'y mettre ma petite touche