[Risolto] Macro: sorteggio casuale di 3 degli 8 numeri presenti in una colonna.

[arckborg]

Salve a tutti, amici del Forum.
Ho un nuovo problemino da risolvere: mi servirebbe una Macro, da attivare tramite il pulsante “Sorteggia” (presente nel Foglio “GIOCATA”), che andando ad operare nel Foglio “SORTEGGIO” andasse ad inserire nella Colonna D7:D30 3 degli 8 Numeri (sorteggiandoli a caso) che sono presenti nella colonna C7:C30.
Spero di essere stato sufficientemente chiaro nell'esplicitare le mie necessita', tuttavia, onde evitare eventuali disguidi e fraintendimenti allego alla presente anche il File in oggetto.

Un cordiale saluto.
Arch. A. Borghini

[charlie]

Salve Gaetano

Nel forum ci si rivolge a tutti i potenziali aiutanti.

[arckborg]

Hai perfettamente ragione. Chiedo umilmente scusa.

[patel]

Puoi sempre correggere il tuo primo post

[Gaetanopr]

Codice: Seleziona tutto

Sub Sorteggio
Dim Doc As Object
Dim Sh As Object
If MsgBox("Sei sicuro di voler sorteggiare i nuovi numeri???", 64+4, "SORTEGGIO")  = 7 Then EXIT SUB
Doc = ThisComponent
Sh = Doc.Sheets.GetByName("SORTEGGIO")
Range = Sh.getCellRangeByName("C7:C30")
Sh.getCellRangeByName("D7:D30").clearContents(1)
  
Dati = Range.GetDataArray
X = Ubound(Dati)
Dim Dic As Object
Set Dic = CreateObject("Scripting.Dictionary") 

Do While A < 3
   Numero = Dati(Int((X * Rnd) ))(0)
   If Numero <> 0 Then
      If Dic.Exists(Numero) = False Then
         Dic.Add Key:= Numero , Item:= Numero
         A = A + 1
         oDescriptor = Range.createSearchDescriptor()
         With oDescriptor
             .SearchString = Numero
             .SearchWords = True
             .SearchType = 1  ' cerca nei valori
             .SearchCaseSensitive = False
         End With
         oFound = Range.findFirst(oDescriptor)
         If Not IsNull(oFound) Then
            r=oFound.getCellAddress.Row
            Sh.getCellByPosition(3, r).Value = Numero
         End If
 
      End If
   End If      
   
Loop

End Sub

[arckborg]

Salve Gaetano, grazie infinite per il tuo cortese aiuto, tuttavia c'e' qualcosa nella routine che non funziona. Forse e' colpa mia perche' nel frattempo ho leggermente modificato ed aggiunto alcune cose. Tuttavia non penso che sia il nome del foglio su cui deve operare la Macro dato che ho provveduto anche a cambiare il suo nome all'interno della stessa.
Per maggiore sicurezza, comunque, in allegato alla presente ti invio sia il nuovo file modificato che lo screenshot relativo al messaggio di errore in questione.

Di nuovo grazie ed un cordiale saluto.
Arch. A. Borghini

[Gaetanopr]

Dall'immagine già si vede che qualcosa non va, fai coesistere macro scritte in VBA per Excel e in basic per openoffice, devi togliere 'Option VBASupport 1, anzi togli tutto il VBA, nel tuo precedente post avevo già convertito una macro che cancellava il contenuto delle celle, quindi dovresti sapere come fare.
Pure in Basic si usa il metodo ClearContents, in questa macro c'è una riga che cancella i numeri delle celle "D7:D30"

Codice: Seleziona tutto

Sh.getCellRangeByName("D7:D30").clearContents(1)

Saluti

[arckborg]

Caro Gaetano, anche dopo aver seguito il tuo consiglio ed aver eliminato dalla MACRO tutta la parte in VBA, anche questa volta mi da errore (vedi file e screenshot allegati). A questo punto non so piu' a che "Santo votarmi"; non mi resta che "affidarmi alle tue prodigiose mani".

Un cordiale saluto.
Arch. A. Borghini

[Gaetanopr]

Non avevo letto la tua firma, il tuo SO non riconosce gli Oggetti Dictionary, cambiamo sistema.

Codice: Seleziona tutto

Sub Sorteggio
Dim Doc As Object
Dim Sh As Object
If MsgBox("Sei sicuro di voler sorteggiare i nuovi numeri ???", 64+4, "SORTEGGIO")  = 7 Then EXIT SUB
Doc = ThisComponent
Sh = Doc.Sheets.GetByName("SORTEGGIO_1")
Range = Sh.getCellRangeByName("C7:C30")
Sh.getCellRangeByName("D7:D30").clearContents(1)
  
Dati = Range.GetDataArray
X = Ubound(Dati)

Do While A < 3
   Numero = Dati(Int((X * Rnd) ))(0)
   If Numero <> 0 Then
         oDescriptor = Range.createSearchDescriptor()
         With oDescriptor
             .SearchString = Numero
             .SearchWords = True
             .SearchType = 1  ' cerca nei valori
             .SearchCaseSensitive = False
         End With
         oFound = Range.findFirst(oDescriptor)
         If Not IsNull(oFound) Then
            r=oFound.getCellAddress.Row
            If Sh.getCellByPosition(3, r).String = "" Then
                Sh.getCellByPosition(3, r).Value = Numero
                A = A + 1
            End If
         End if
      End If

Loop
End Sub

[arckborg]

Perfetto, ora la Macro funziona perfettamente.
Grazie infinite Gaetano.

Un cordiale saluto.
Arch. A. Borghini