Modification de macro qui plante

[guenfood]

Bonjour,

J'ai récupéré une macro sur un site que j'ai modifié pour l'appliquer à mon cas

Option Explicit

Sub tirage
Dim ListeOrig(2662), ListeRes(2662) As String
Dim n, k As Integer
Dim Col, Lig As Long
Dim lOk As Boolean
' Récupération des 64 noms
For n = 1 TO 2662
ListeOrig(n) = thisComponent.Sheets(0).getCellByPosition(0,n).string
next n
' Réorganisation aléatoire
For n = 1 TO 2662
Do
lOk = False
k = int(rnd()*2662) + 1
If ListeOrig(k) <> "" Then
ListeRes(n) = ListeOrig(k)
ListeOrig(k) = ""
lOk = True
End if
Loop While (NOT lOk )
Next n
'Affichage par poule
For Col = 0 TO 1
For Lig = 1 To 5
thisComponent.Sheets(0).getCellByPosition(Col+3,Lig).string = ListeRes(Col*2+Lig)
next Lig
next Col
End Sub


A l'origine, à la place de tous les 2662, il y avait 64.
Lorsque j'exécute la macro, soit j'ai le message ci-dessous
"Valeur ou type de données incorrect. Index hors de la plage définie."

Soit je me retrouve avec des noms tirés au sort dans ma première et deuxième colonne qui sont identiques.


Pour résumer, je dois faire un tirage au sort parmi 2662 personnes pour déterminer 5 gagnants dans 2 catégories.
Chaque catégorie correspondant au lot remporté.

Pouvez-vous m'éclairer ?

Merci par avance.

 

[Theze]

Re : Modification de macro qui plante

Bonjour,

Regarde si ceci convient. Il te faut adapter en fonction des résultats voulus :

Sub tirage()
    
    'dictionnaire pour s'assurer des valeurs uniques
    Dim Dico As Object
    Dim Cle
    
    'tableaux à une dimension
    Dim ListeOrig(1 To 2662)
    Dim ListeRes(1 To 2662) As String
    
    Dim n As Integer
    Dim k As Integer
    Dim NB As Long
    
    'Récupération des 2662 noms en colonne A de la feuille "Feuil1", à adapter !!!
    NB = 2662
    
    For n = 1 To NB
    
        ListeOrig(n) = Worksheets("Feuil1").Range("A" & n)
    
    Next n
    
    'crée le dictionnaire
    Set Dico = CreateObject("Scripting.Dictionary")
    
    'Réorganisation aléatoire en stockant les valeurs dans le dico
    Do
    
        k = Int(Rnd() * NB) + 1
        
        If Dico.Exists(k) = False Then
        
            Dico.Add k, k
        
        End If
    
    Loop Until Dico.Count = NB
    
    'récup des clés
    Cle = Dico.keys
    
    n = 0
    
    'transfert entre tableaux
    For Each Cle In Dico.keys
    
        n = n + 1
        ListeRes(n) = ListeOrig(Cle)
        
    Next


    'Affichage par poule Avoir ici si c'est correct (je me suis probablement plenté :o(( )
    For n = 1 To 2

        For k = 1 To 5

        Worksheets("Feuil1").Cells(k, n + 2) = ListeRes(n * 2 + k)

        Next k

    Next n
    
End Sub

Hervé.

 

[Bebere]

Re : Modification de macro qui plante

bonjour
à essayer un code de Frédéric Sigonneau

Sub RandomPlage(Plage As Range, Optional Max As Long = 0)
    Dim Arr(), ArrTmp, temp, idx As Long, i As Long, j&

    Randomize
    ArrTmp = Plage.Value

    'Tri aléatoire du tableau
    For i = Plage.Rows.Count To 1 Step -1
        idx = Int(Rnd() * i) + 1
        temp = ArrTmp(i, 1)
        ArrTmp(i, 1) = ArrTmp(idx, 1)
        ArrTmp(idx, 1) = temp
        j = Plage.Rows.Count - i
        If Max > 0 And j = Max Then Exit For
        ReDim Preserve Arr(j)
        Arr(j) = ArrTmp(i, 1)
    Next i

    Plage.Range("B1:B" & UBound(Arr) + 1).Value = _
    Application.Transpose(Arr)

End Sub    'fs

'exemple
'pour renvoyer en B1:B7 les 7 premières valeurs, après tri, de la
'plage A1:A49 :
Sub test()
    Dim DerL As Long

    Application.ScreenUpdating = False
    DerL = Range("A65536").End(xlUp).Row
    RandomPlage Range("A1:A" & DerL)    ', 7
    Application.ScreenUpdating = True
End Sub

à bientôt

 

[guenfood]

Re : Modification de macro qui plante

Merci pour votre aide.
Malheureusement, cela ne fonctionne pas chez moi.
J'ai l'impression que le VBA d'Excel et le VBA d'OpenOffice 3.3, ce n'est pas très compatible :-(

 

[Theze]

Re : Modification de macro qui plante

Re,

Pas mal de commandes Excel PC plante sur Excel Mac alors sur OpenOffice !!!

Hervé.