Excel VBA : Format de cellule et Copie auto

Résolu
TeTo25 Messages postés 33 Statut Membre -  
 TeTo25 -
Bonjour,

J'ai créer un fichier permettant de générer des valeurs aléatoires comprises entre deux bornes et dans un "tableau" aux dimensions variables :



J'aimerais que le format des cellules remplies dépende du nombre de décimales ("G3") et que les valeurs générées soient automatiquement copiées mais je n'y arrive pas.
Voici mon code actuel : 

Sub Remplissage_aléatoire()
'
'
' Remplissage d'une zone de dimension variable par des valeurs aléatoires comprises entre deux bornes définies


' Définition des variables

Dim Min, Max As Double
Dim i, j, k, Dec, NbCol, NbLig As Integer

Min = 0
Max = 0
Dec = 0
NbCol = 0
NbLig = 0
i = 0
j = 0
k = 0

' Activer le mode aléatoire

Randomize

' Récupération des paramètres

Min = Range("A3").Value
Max = Range("D3").Value
Dec = Range("G3").Value
NbCol = Range("A5").Value - 1
NbLig = Range("D5").Value - 1

' Validation des données saisies

If Max - Min <= 0 Then

    MsgBox ("La borne supérieure doit être plus grande que la borne inférieure")    ' Message d'erreur 1
    GoTo Line1

End If

If NbCol <= 0 Or NbLig <= 0 Then

    MsgBox ("Le nombre de colonnes ou lignes doit être supérieur ou égal à 1")      ' Message d'erreur 2
    GoTo Line1

End If

' Traitement des données et remplissage des cases

For i = 0 To NbCol Step 1                               ' Colonnes

    For j = 0 To NbLig Step 1                           ' Lignes
    
        Range("A7").Offset(j, i) = Int(((Min + (Max - Min) * Rnd)) * 10 ^ Dec) / (10 ^ Dec) ' Valeur aléatoire entre les bornes
                
    Next j
    
Next i

k = (NbCol + 1) * (NbLig + 1)   ' Nombre de cellules remplies

MsgBox (k & " cellules ont été remplies par des nombres compris entre " & Min & " et " & Max & ".") ' Message de validation

Line1:
End Sub

Sub Réinitialiser()

    Rows("7:2000").Select
    Selection.ClearContents
    Range("A7").Select
    
End Sub


J'ai essayé : 
 ' Dans la boucle de traitement
Range("A7").Offset(j, i).Select 
x = ActiveCell.Row
y = ActiveCell.Column

' A la fin 
Range("A7" & Cells(x,y)).Copy


Mais ça n'a pas fonctionné

voici un lien pour télécharger mon fichier :
http://www.mediafire.com/file/gwicq1j36jicw29/Alea.xlsm/file
Merci d'avance
A voir également:

2 réponses

Réponse 1 / 2
f894009 Messages postés 17414 Date d'inscription   Statut Membre Dernière intervention   1 715
 
Bonjour,

fichier modifie avec separateur decimale utilise dans l'Excel ouvert: https://mon-partage.fr/f/Rilr8Kuj/
1
TeTo25 Messages postés 33 Statut Membre 1
 
Merci de ta réponse,

Je ne sais pas pourquoi mais ta solution ne fonctionne pas parfaitement...


Mais j'ai réussi à bidouiller autre chose qui fonctionne (Ce n'est pas parfait) : 

Sub Remplissage_Aléatoire()

'
'
' Remplissage d'une zone de dimension variable par des valeurs aléatoires comprises entre deux bornes définies


' Définition des variables

Dim Min, Max As Double
Dim i, j, k, Dec, NbCol, NbLig As Integer
Dim Format As String


Min = 0
Max = 0
Dec = 0
NbCol = 0
NbLig = 0
i = 0
j = 0
k = 0

' Activer le mode aléatoire

Randomize

' Récupération des paramètres

Min = Range("A3").Value
Max = Range("D3").Value
Dec = Range("G3").Value
NbCol = Range("A5").Value - 1
NbLig = Range("D5").Value - 1
Format = Left("0.00000000", Dec + 2)

' Validation des données saisies

If Max - Min <= 0 Then

    MsgBox ("La borne supérieure doit être plus grande que la borne inférieure")    ' Message d'erreur 1
    Exit Sub
    
End If

If NbCol <= 0 Or NbLig <= 0 Then

    MsgBox ("Le nombre de colonnes ou lignes doit être supérieur ou égal à 1")      ' Message d'erreur 2
    Exit Sub
    
End If

' Traitement des données et remplissage des cases

For i = 0 To NbCol Step 1                               ' Colonnes

    For j = 0 To NbLig Step 1                           ' Lignes
    
        Range("A7").Offset(j, i) = Int(((Min + (Max - Min) * Rnd)) * 10 ^ Dec) / (10 ^ Dec) ' Valeur aléatoire entre les bornes
        Range("A7").Offset(j,i).select
        Selection.NumberFormat = Format
       
    Next j
    
Next i


k = (NbCol + 1) * (NbLig + 1)   ' Nombre de cellules remplies

MsgBox (k & " cellules ont été remplies par des nombres compris entre " & Min & " et " & Max & ".") ' Message de validation


End Sub


Merci pour la modification sur Exit Sub, cela fait plus propre dans le code.

Pas d'idée pour la copie automatique de l'ensemble des valeurs ?
0
f894009 Messages postés 17414 Date d'inscription   Statut Membre Dernière intervention   1 715
 
Re,

Pas d'idée pour la copie automatique de l'ensemble des valeurs ?
Actuellement vous ecrivez bien dans des cellules!!!!!!!!!!!!!!!!!!!!!
0
TeTo25 Messages postés 33 Statut Membre 1 > f894009 Messages postés 17414 Date d'inscription   Statut Membre Dernière intervention  
  

Re, 

Pas d'idée pour la copie automatique de l'ensemble des valeurs ? 
Actuellement vous ecrivez bien dans des cellules!!!!!!!!!!!!!!!!!!!!!


Oui bien entendu les valeurs sont mises dans les cellules de ce classeur. Cependant je les génères ici pour les copier ensuite dans d'autre classeurs qui ont des formats différents.

Dans le cas ou je génère des valeurs dans un tableau de 10x10 tout va bien, je sélectionne facilement mes données pour les copier où j'en ai besoin.

Cependant si je génère 10 000 Valeurs dans un tableau de 100x100 ou de 10x1000, c'est bien plus long de les sélectionner

C'est pourquoi j'aimerais qu'à la fin de la macro, l'ensemble des cellules remplies soient sélectionnées ou copiées.
Un peu comme ça : 

Range("A7:Dernière Cellule").Copy


Avec "Dernière Cellule " qui dépend de NbCol et NbLig...

Sauf que j'ai tenté d'écrire : 

Range("A7:" & Variable).Copy


Mais ça ne fonctionne pas... Alors qu'il me semble que : 

Range(Variable & ":B20").Copy


peut fonctionner... Je pense que c'est un problème de syntaxe mais je ne trouve pas la solution
0
f894009 Messages postés 17414 Date d'inscription   Statut Membre Dernière intervention   1 715
 
Re,
Au fait: Je ne sais pas pourquoi mais ta solution ne fonctionne pas parfaitement...
Qu'est-ce qui ne va pas "parfaitement"
pour la copy a votre facon 
Range(Cells(7, 1), Cells(Nblig, Nbcol)).Copy
0
TeTo25
 
Regardez l'image que j'avais postée les cases sont remplies de "030".
0
Réponse 2 / 2
TeTo25 Messages postés 33 Statut Membre 1
 
C'est tout bon j'ai réussi à résoudre mes problèmes.

Le format de cellule se gère automatiquement (uniquement pour 1 à 8 décimales)
Les cellules remplies sont copiées à la fin


Voici le code final que j'ai utilisé : 

Option Explicit
Sub Remplissage_Aléatoire()

' Remplissage d'une zone de dimension variable par des valeurs aléatoires comprises entre deux bornes définies

' Programmation éffectuée par TeTo25
' ___________________________________________
' Réinitialiser les valeurs précédentes

Call Réinitialiser

' ___________________________________________
' Définition des variables

Dim Min, Max As Double
Dim i, j, k, Dec, NbCol, NbLig As Integer
Dim Format, Cell As String


Min = 0
Max = 0
Dec = 0
NbCol = 0
NbLig = 0
i = 0
j = 0
k = 0

' ___________________________________________
' Activer le mode aléatoire

Randomize

' ___________________________________________
' Récupération des paramètres

Min = Range("A3").Value
Max = Range("D3").Value
Dec = Range("G3").Value
NbCol = Range("A5").Value - 1
NbLig = Range("D5").Value - 1
Format = Left("0.00000000", Dec + 2)

' ___________________________________________
' Validation des données saisies

If Max - Min <= 0 Then

    MsgBox ("La borne supérieure doit être plus grande que la borne inférieure")    ' Message d'erreur 1
    Exit Sub
    
End If

If NbCol <= 0 Or NbLig <= 0 Then

    MsgBox ("Le nombre de colonnes ou lignes doit être supérieur ou égal à 1")      ' Message d'erreur 2
    Exit Sub
    
End If

' ___________________________________________
' Traitement des données et remplissage des cases

For i = 0 To NbCol Step 1               ' Colonnes

    For j = 0 To NbLig Step 1           ' Lignes
    
        Range("A7").Offset(j, i) = Int(((Min + (Max - Min) * Rnd)) * 10 ^ Dec) / (10 ^ Dec) ' Valeur aléatoire entre les bornes
        Range("A7").Offset(j, i).Select
        
                
    Next j
    
Next i

' ___________________________________________
' Changement du format des cellules et copies des données

Cell = ActiveCell.Address               ' Récupération de l'adresse de la dernière cellule remplie
Range("A7:" & Cell).Select              ' Sélection de l'ensemble des cellules remplies
Selection.NumberFormat = Format         ' Modification du format (Nombre de décimales)
Selection.Copy                          ' Copies des cellules
Range("A7").Select                      ' Désactivation de la grande sélection (uniquement pour l'aspect visuel)


' ___________________________________________
' Message de Validation final

k = (NbCol + 1) * (NbLig + 1)           ' Nombre de cellules remplies
MsgBox (k & " cellules ont été remplies par des nombres compris entre " & Min & " et " & Max & ".") ' Message de validation

End Sub

Sub Réinitialiser()

' Réinitialisation des cellules

' Programmation éffectuée par TeTo25

    Rows("7:999999").Select
    Selection.ClearContents
    Range("A7").Select
    
End Sub


Voici le résultat final :

Merci pour l'aide
1
f894009 Messages postés 17414 Date d'inscription   Statut Membre Dernière intervention   1 715
 
Re,
Si vous le dites...
Evitez d'utiliser des noms de variable ou autre qui sont des instructions ex: Format = Left("0.00000000", Dec + 2)
0