couper un nombre

Salut Pascal,

Ça ne me semble pas évident cette affaire-là.
Voici tout de même une piste à dépoussiérer :

Sub Sépare()
Dim p(1 To 20)
n = [a1]
Randomize
p(1) = Left(n, Int(Len(n) * Rnd() + 1))
p(2) = Right(n, Len(n) - Len(p(1)))
For i = 1 To 5
p(2 * i + 1) = Left(p(2 * i), Int((Len(p(2 * i)) - 1 + 1) * Rnd + 1))
p(2 * i + 2) = Right(p(2 * i), Len(p(2 * i)) - Len(p(2 * i + 1)))
Next i
For j = 1 To 6
rep = rep & p(2 * j - 1) & " "
Next j
[a2] = rep & p(20)
End Sub

Serge



"Pascal" <scalpanospm@wanadoo.rf> a écrit dans le message de news: 4516c777$0$27405$ba4acef3@news.orange.fr...

--
bonjour
Y a t il une technique pour couper un nombre contenu dans une cellule en plusieurs morceaux de taille différente et ceci de façon
aléatoire ?
A1= 123456789 donnerait par exemple 12 345 6789 ou 1 234 567 89 ou 12345 6789 etc..
merci

http://www.scalpa.info

Ça ne me semble pas évident cette affaire-là. à moi non plus qui découvre
vba.
J'ai modifié ton code comme ceci sans résultat... j'ai créé un module (une

macro ?) peux tu m'aiguiller encore merci
Option Explicit
Public Function Separe(Nombre As Integer) As String
Dim p(1 To 20)
Dim n, i, j As Integer
Dim rep As Variant
n = Nombre 'le nbre contenu dans la cellule
Randomize
p(1) = Left(n, Int(Len(n) * Rnd() + 1)) ' prend les n caractères
depuis la gauche
p(2) = Right(n, Len(n) - Len(p(1))) ' prend les n caractères depuis
la droite (ceux qui restent donc ?)
For i = 1 To 5
p(2 * i + 1) = Left(p(2 * i), Int((Len(p(2 * i)) - 1 + 1) * Rnd
+ 1)) ' là je ne comprends plus...
p(2 * i + 2) = Right(p(2 * i), Len(p(2 * i)) - Len(p(2 * i +
1))) ' là je ne comprends plus...
Next i
For j = 1 To 6
rep = rep & p(2 * j - 1) & " "
Next j
Separe = rep & p(20)
End Function

Voici tout de même une piste à dépoussiérer :

Sub Sépare()
Dim p(1 To 20)
n = [a1]
Randomize
p(1) = Left(n, Int(Len(n) * Rnd() + 1))
p(2) = Right(n, Len(n) - Len(p(1)))
For i = 1 To 5
p(2 * i + 1) = Left(p(2 * i), Int((Len(p(2 * i)) - 1 + 1) * Rnd
+ 1))
p(2 * i + 2) = Right(p(2 * i), Len(p(2 * i)) - Len(p(2 * i +
1)))
Next i
For j = 1 To 6
rep = rep & p(2 * j - 1) & " "
Next j
[a2] = rep & p(20)
End Sub

Serge



"Pascal" <scalpanospm@wanadoo.rf> a écrit dans le message de news:
4516c777$0$27405$ba4acef3@news.orange.fr...

--
bonjour
Y a t il une technique pour couper un nombre contenu dans une cellule en
plusieurs morceaux de taille différente et ceci de façon aléatoire ?
A1= 123456789 donnerait par exemple 12 345 6789 ou 1 234
567 89 ou 12345 6789 etc..
merci

http://www.scalpa.info

bonjour j'ai trouvé une fonction qui coupe en morceaux mais n'arrive pas à
obtenir de résultats... Quelqu'un peut il m'expliquer comment ça marche ?
merci
###########################""
'
http://perso.orange.fr/frederic.sigonneau/code/Fonctions/CoupeChaineEnMorceaux.txt

Attribute VB_Name = "CoupeChaineEnMorceaux"


Function CoupeTexte(cell As Range, Optional NbMorceaux As Byte = 2) As
Variant
'découpe le texte d'une cellule en NbMorceaux
'fs, mpfe
Dim tabTxt, I%, J%, K%
Dim tabRes(), NbEl%

If NbMorceaux < 2 Then
CoupeTexte = CVErr(xlValue)
Exit Function
End If

tabTxt = Split(cell.Text, " ")
NbEl = Application.RoundUp((UBound(tabTxt) + 1) / NbMorceaux, 0)
On Error Resume Next
For I = 0 To NbMorceaux - 1
ReDim Preserve tabRes(I)
For J = K To K + NbEl - 1
tabRes(I) = tabRes(I) & tabTxt(J) & " "
Next
K = K + NbEl
Next

If Application.Caller.Rows.Count = 1 Then
CoupeTexte = tabRes
Else
CoupeTexte = Application.Transpose(tabRes)
End If

End Function

Sub test()
MsgBox CoupeTexte(Range("C1"), 2)(0)
End Sub

###############################


http://www.scalpa.info

| Function CoupeTexte(cell As Range, Optional NbMorceaux As Byte = 2)

C'est une fonction qui scinde une chaîne de caractère selon
un séparateur défint dans la fonction comme étant l'"espace.
On observe cela dans la ligne de code suivante :
tabTxt = Split(cell.Text, " ")

En fait, la fonction compte le nombre d'espace dans la chaîne
de caractères, chaque section à la valeur d'un morceau de la
chaîne.. et la fonction va scinder la chaîne de caractère en la
divisant par le nombre de morceaux que tu auras passé comme
paramêtre (Optional NbMorceaux As Byte = 2)

Si le nombre obtenu n'est pas un chiffre entier, il se sert
de la fonction RoundUp pour arrondir le résultat à l'entier
supérieur le plus près.

Exemple : "La chaise est lourde" écrit en cellule C1
Nombre d'espace 4
Nombre de morceaux désirés 2

Les 2 nouveaux morceaux seront :
Morceau 1 : La chaise
Morceau 2 : est lourde

La boucle dans la fonction est utilisé pour reconstituer
chacun des morceaux et elle stocke chaque nouveau
morceau dans un tableau tabRes(I)



Chaque section de la chaine ainsi formée est mise dans une
variable de type tableau qui est la fonction elle-même
CoupeTexte() . Observe bien dans la déclaration de la
fonction, il a donné le type "Variant" à CoupeTexte.

Dans la boucle, il y a ceci :
tabRes(I) = tabRes(I) & tabTxt(J) & " "

Quand il appelle la fonction avec :
MsgBox CoupeTexte(Range("C1"), 2)(0)

Range("C1") = Où est le texte à scinder
2 = nombre de morceaux qu'il désires obtenir
(0) -> c'est l'indice de la valeur du tableau qu'il
désire afficher dans un message box.
(un tableau sauf avis contraire est de base 0)

Dans mon exemple de tantôt, le message serait :" La chaise"
et s'il avait utilisé (1) dans la commande, il aurait obtenu
"est lourde"

Voilà ...





"Pascal" <scalpanospm@wanadoo.rf> a écrit dans le message de news:
451f9e9d$0$27405$ba4acef3@news.orange.fr...
bonjour j'ai trouvé une fonction qui coupe en morceaux mais n'arrive pas à
obtenir de résultats... Quelqu'un peut il m'expliquer comment ça marche ?
merci
###########################""
'
http://perso.orange.fr/frederic.sigonneau/code/Fonctions/CoupeChaineEnMorceaux.txt

Attribute VB_Name = "CoupeChaineEnMorceaux"


Function CoupeTexte(cell As Range, Optional NbMorceaux As Byte = 2) As
Variant
'découpe le texte d'une cellule en NbMorceaux
'fs, mpfe
Dim tabTxt, I%, J%, K%
Dim tabRes(), NbEl%

If NbMorceaux < 2 Then
CoupeTexte = CVErr(xlValue)
Exit Function
End If

tabTxt = Split(cell.Text, " ")
NbEl = Application.RoundUp((UBound(tabTxt) + 1) / NbMorceaux, 0)
On Error Resume Next
For I = 0 To NbMorceaux - 1
ReDim Preserve tabRes(I)
For J = K To K + NbEl - 1
tabRes(I) = tabRes(I) & tabTxt(J) & " "
Next
K = K + NbEl
Next

If Application.Caller.Rows.Count = 1 Then
CoupeTexte = tabRes
Else
CoupeTexte = Application.Transpose(tabRes)
End If

End Function

Sub test()
MsgBox CoupeTexte(Range("C1"), 2)(0)
End Sub

###############################


http://www.scalpa.info