Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Microsoft 365 Coller un code aleatoire dans une cellule sélectionnées au hasard

LandryK7

XLDnaute Nouveau
bonjour, Je n'arrive pas à faire fonctionner le code ci dessous sensé choisir au hasard une cellule dans une plage donnée et y coller un code aléatoire de 20 caractères. Help please

Sub Code_AleaDecomptage()

Sheets("Aleatoire").Select

LettreAleatoires = ""

Carac = "ABCDEFGHJKMNPQRSTUVWXYZ123456789abcdefghjkmnpqrstuvwxyz"

For i = 1 To 20

NombreAleatoires = Int(Len(Carac) * Rnd) + 1

LettreAleatoires = LettreAleatoires & Mid(Carac, NombreAleatoires, 1)

Next i

Range("m1") = LettreAleatoires

End Sub

Sub Selection_Alea()

Call Code_AleaDecomptage

'Sélection aléatoire d'une cellule

Cells(Int(Rnd * 10) + 1, Int(Rnd * 10) + 1).Select


If Selection <> Range("a1") And Selection <> Range("d4") _

And Selection <> Range("e5") And Selection <> Range("f8") _

And Selection <> Range("b8") Then

Selection = Range("m1").Value

End If

End Sub
 
Solution
Bonjour @LandryK7, sylvanu,

Je te propose le fichier ci-dessous ; fais Ctrl e plusieurs fois ; tu pourras voir
qu'effectivement, les 5 cellules A1, D4, E5, F8 et B8 sont préservées.

voici le code VBA :

VB:
Option Explicit

Function CodAlea() As String
  Const Carac$ = "ABCDEFGHJKMNPQRSTUVWXYZ123456789abcdefghjkmnpqrstuvwxyz"
  Dim chn$, lng As Byte, p As Byte, i As Byte: lng = Len(Carac)
  For i = 1 To 20
    p = Int(Rnd * lng) + 1: chn = chn & Mid$(Carac, p, 1)
  Next i
  CodAlea = chn
End Function

Sub Selection_Alea()
  Randomize Timer
  With Worksheets("Aleatoire").Cells(Int(Rnd * 10) + 1, Int(Rnd * 10) + 1)
    If InStr("A1 D4 E5 F8 B8", .Address(0, 0)) = 0 Then .Value = CodAlea()
  End With
End Sub
...

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Landry,
Voir PJ avec :
VB:
Sub Selection_Alea()
Call Code_AleaDecomptage
'Sélection aléatoire d'une cellule
Cells(Int(Rnd * 10) + 1, Int(Rnd * 10) + 1).Select
If Selection.Address <> "a1" And Selection.Address <> "d4" _
And Selection.Address <> "e5" And Selection.Address <> "f8" _
And Selection.Address <> "b8" Then
    Selection = Range("m1").Value
End If
End Sub
 

Pièces jointes

  • Classeur2.xlsm
    15.6 KB · Affichages: 15

LandryK7

XLDnaute Nouveau
Désolé Sylvanu. Je ne l'ai pas dis mais dans le code l'objectif est aussi d'éviter de mettre les codes aléatoires dans les cellules que j'ai indiqué. C'est pourquoi j'ai mis la condition IF
 
Dernière édition:

soan

XLDnaute Barbatruc
Inactif
Bonjour @LandryK7, sylvanu,

Je te propose le fichier ci-dessous ; fais Ctrl e plusieurs fois ; tu pourras voir
qu'effectivement, les 5 cellules A1, D4, E5, F8 et B8 sont préservées.

voici le code VBA :

VB:
Option Explicit

Function CodAlea() As String
  Const Carac$ = "ABCDEFGHJKMNPQRSTUVWXYZ123456789abcdefghjkmnpqrstuvwxyz"
  Dim chn$, lng As Byte, p As Byte, i As Byte: lng = Len(Carac)
  For i = 1 To 20
    p = Int(Rnd * lng) + 1: chn = chn & Mid$(Carac, p, 1)
  Next i
  CodAlea = chn
End Function

Sub Selection_Alea()
  Randomize Timer
  With Worksheets("Aleatoire").Cells(Int(Rnd * 10) + 1, Int(Rnd * 10) + 1)
    If InStr("A1 D4 E5 F8 B8", .Address(0, 0)) = 0 Then .Value = CodAlea()
  End With
End Sub
remarque : note bien que je n'ai pas utilisé la cellule M1.

tu demandes : « qu'est-ce que c'est Randomize Timer ? à quoi ça sert ? » ;
oh, j'en sais rien ; je l'ai mis comme ça, à tout hasard ; c'est juste une
lubie de programmeur ; faut pas t'inquiéter pour si peu ! si vraiment
tu tiens à le savoir, je te laisse chercher dans l'Aide VBA.


soan
 

Pièces jointes

  • Exo LandryK7.xlsm
    14.2 KB · Affichages: 4
Dernière édition:

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour à tous de si bon matin,
@Landkry,
J'avais compris, mais j'avais un bug. Selection.address n'est pas une chaine. J'avais oublié le CSTr.
VB:
Sub Selection_Alea()
Call Code_AleaDecomptage
'Sélection aléatoire d'une cellule
Cells(Int(Rnd * 10) + 1, Int(Rnd * 10) + 1).Select
N = CStr(Selection.Address)
If N <> "$A$1" And N <> "$D$4" And N <> "$E$5" And N <> "$F$8" And N <> "$B$8" Then
    ActiveCell = Range("m1").Value
End If
End Sub
 

Pièces jointes

  • Classeur2 (3).xlsm
    19.1 KB · Affichages: 2

LandryK7

XLDnaute Nouveau
Merci Soan! ça fonctionne comme il faut
 
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…