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

XL 2016 Problème tri aléatoire de nombres avec macro

Julien1986

XLDnaute Nouveau
Bonjour,
J'ai repris cette macro pour trier aléatoirement et sans doublon des nombres de 1 à 2065 dans une feuille excel.

Sub Aleatoire()
Dim plage As Range, cel As Range, alea As Double
Set plage = Range("A1:A35:B1:B35:C1:C35135:E1:E35:F1:F35:G1:G35:H1:H35:I1:I35:J1:J35:K1:K35:L1:L35:M1:M35:N1:N35:O1:O35135:Q1:Q35:R1:R35:S1:S35:T1:T35:U1:U35:V1:V35:W1:W35:X1:X35:Y1:Y35:Z1:Z35:AA1:AA35:AB1:AB35:AC1:AC35:AD1:AD35:AE1:AE35:AF1:AF35:AG1:AG35:AH1:AH35:AI1:AI35")
plage.Value = ""
If plage.Count > 2065 Then Exit Sub
Randomize
For Each cel In plage
1 alea = WorksheetFunction.RandBetween(1, 2065)
If Application.CountIf(plage, alea) Then GoTo 1 Else cel = alea
Next
End Sub


Lorsque j'arrive à la colonne AI1:AI35 dans la ligne RANGE, une erreur s'affiche et avant cela, la macro fonctionne.
Et j'ai encore plusieurs colonnes à ajouter à la suite
Avez-vous une idée du pourquoi?
Salutations.
 

Paf

XLDnaute Barbatruc
Bonjour,

Pas saisi où était signalée l'erreur.
VB:
Set plage = Range("A1:A35:B1:B35:C1:C35:D1:D35:E1:E35:F1:F35:G1:G35:H1:H35:I1:I35:J1:J35:K1:K35:L1:L35:M1:M35:N1:N35:O1:O35:p1:p35:Q1:Q35:R1:R35:S1:S35:T1:T35:U1:U35:V1:V35:W1:W35:X1:X35:Y1:Y35:Z1:Z35:AA1:AA35:AB1:AB35:AC1:AC35:AD1:AD35:AE1:AE35:AF1:AF35:AG1:AG35:AH1:AH35:AI1:AI35")

peut s'écrire plus simplement :
VB:
Set plage = Range("A1:AI35")

le code réécrit car ne tournait pas sur XL 2003:
VB:
Sub Aleatoire()
Dim plage As Range, cel As Range, alea As Integer
Set plage = Range("A1:AI35")
plage.Value = ""
If plage.Count > 2065 Then Exit Sub
Randomize
For Each cel In plage
    Do
        alea = Int(2065 * Rnd) + 1
    Loop While Application.CountIf(plage, alea) > 0
    cel = alea
Next
End Sub

A+
 

eriiic

XLDnaute Barbatruc
Bonjour à tous,

Paf, tu es sûr d'éviter les doublons avec
VB:
Loop While Application.CountIf(plage, alea) > 0
? plutôt =1 non ?

Quoiqu'il en soit une autre façon :
Code:
Sub Aleatoire()
    Dim pl As Range, n(1 To 2065), tabl() As Long, alea As Long
    Dim i As Long, j As Long, k As Long, tmp As Long
    Set pl = Range("A1:AI35")
    If pl.Count > 2065 Then Exit Sub
    For i = 1 To 2065: n(i) = i: Next
    Randomize
    For i = 1 To 2065
        alea = WorksheetFunction.RandBetween(1, 2065)
        tmp = n(i): n(i) = n(alea): n(alea) = tmp
    Next i
    ReDim tabl(1 To pl.Rows.Count, 1 To pl.Columns.Count)
    For i = 1 To UBound(tabl, 1)
        For j = 1 To UBound(tabl, 2)
            k = k + 1
            tabl(i, j) = n(k)
        Next j
    Next i
    pl.CurrentRegion.ClearContents
    pl = tabl
End Sub
eric
 

Paf

XLDnaute Barbatruc
Bonjour eriiiic

heu...tu me fais douter...

on génère un nombre (alea) .s'il existe déjà un dans la plage (CountIf(plage, alea) > 0) on recommence jusqu'à ce que CountIf(plage, alea) ne soit pas > 0 alors on "colle" ce nombre dans la plage.

donc, a priori pas de doublon.

A+
 

Julien1986

XLDnaute Nouveau



Merci pour vos réponses.
J'ai changé sur votre macro la colonne de fin DG35 au lieu de AI35.
La macro ne fonctionne plus avec ce changement.
Dois-je modifier autre chose?

Sub Aleatoire()
Dim pl As Range, n(1 To 2065), tabl() As Long, alea As Long
Dim i As Long, j As Long, k As Long, tmp As Long
Set pl = Range("A1G35")
If pl.Count > 2065 Then Exit Sub
For i = 1 To 2065: n(i) = i: Next
Randomize
For i = 1 To 2065
alea = WorksheetFunction.RandBetween(1, 2065)
tmp = n(i): n(i) = n(alea): n(alea) = tmp
Next i
ReDim tabl(1 To pl.Rows.Count, 1 To pl.Columns.Count)
For i = 1 To UBound(tabl, 1)
For j = 1 To UBound(tabl, 2)
k = k + 1
tabl(i, j) = n(k)
Next j
Next i
pl.CurrentRegion.ClearContents
pl = tabl
End Sub
 

Paf

XLDnaute Barbatruc
VB:
If pl.Count > 2065 Then Exit Sub

cette ligne de code a été conservée dans les propositions sans savoir son bien fondé .
Avec l'extension à DG35 , la plage compte 2975 cellules. donc on sort de la sub sans exécuter le code.

Si la ligne de code ci dessus ne sert à rien, la supprimer.

A+
 
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…