excel genera numei casuali senza ripetizione scelti da elenco

Question

buona sera a tutti spero che qualcuno mi potrà aiutare  

vorrei generare dei numeri casuali senza ripetizione scelti da elenco 

in un riquadro" g5:k6"  ho creato i numeri da scegliere invece in "a1:e20" vengono messi i numeri  selezionati casuali ,ma qui viene il problema i numeri a volte nelle righe si doppiano . come faccio a eliminare il problema  vi allego l'immagine  affinché possa essere più esplicito

" utilizzo office 2007 enterprise

Answer 1

Ciao vorget,

Ecco mio ultimo suggerimento che riempe l'intervallo selezionato da te, evitando la presenza di doppioni nelle righe:

'=========>>

Option Explicit

'--------->>

Public Sub Tester()

    Dim WB As Workbook

    Dim SH As Worksheet

    Dim destRng As Range, srcRng As Range

    Dim arrIn As Variant, arrShuffled() As Variant

    Dim arrUnique() As Variant

    Dim i As Long

    Const sFoglio As String = "Foglio1"                             '<<=== Modifica

    Const sIntervalloSorgente As String = "G5:K6"

    Set WB = ThisWorkbook

    Set SH = WB.Sheets(sFoglio)

    Set srcRng = SH.Range(sIntervalloSorgente).CurrentRegion

    Set destRng = Application.InputBox( _

                  Prompt:="Seleziona  o digita l'intervallo di elaborazione", _

                  Type:=8, _

                  Title:="Intervallo di Elaborazione Casuale")

    arrIn = srcRng.Value

    arrUnique = SortedUniqueList(arrIn)

    With destRng

        .CurrentRegion.ClearContents

        For i = 1 To .Rows.Count

            arrShuffled = ShuffleArray(arrUnique)

            .Rows(i).Value = arrShuffled

        Next i

    End With

XIT:

End Sub

'--------->>

Public Function SortedUniqueList(V As Variant)

    Dim oSortedUniqueList As Object

    Dim arrOut() As Variant

    Dim iVal As Long

    Dim i As Long, j As Long

    Set oSortedUniqueList = CreateObject("System.Collections.Sortedlist")

    With oSortedUniqueList

        For i = LBound(V) To UBound(V)

            For j = 1 To UBound(V, 2)

                iVal = V(i, j)

                If Not iVal = 0 Then

                    If Not .ContainsKey(iVal) Then

                        .Add Key:=iVal, Value:=i

                    End If

                End If

            Next j

        Next i

        ReDim arrOut(1 To .Count)

        For i = 0 To .Count - 1

            arrOut(i + 1) = .GetKey(i)

        Next i

    End With

    SortedUniqueList = arrOut

End Function

'--------->>

Public Function ShuffleArray(InArray() As Variant) As Variant()

    Dim N As Long

    Dim Temp As Variant

    Dim j As Long, L As Long

    Dim Arr() As Variant

    Randomize

    L = UBound(InArray) - LBound(InArray) + 1

    ReDim Arr(LBound(InArray) To UBound(InArray))

    For N = LBound(InArray) To UBound(InArray)

        Arr(N) = InArray(N)

    Next N

    For N = LBound(InArray) To UBound(InArray)

        j = CLng(((UBound(InArray) - N) * Rnd) + N)

        Temp = Arr(N)

        Arr(N) = Arr(j)

        Arr(j) = Temp

    Next N

    ShuffleArray = Arr

End Function

'<<=========

===

Regards,

Norman

Answer 2

...

Allora, temo di aver capito poco della tua domanda originale!

..

===

Regards,

Norman

Ciao Fratello! Anch'io.

Comunque, solo per chi fosse interessato a una soluzione con formule e tanto per fornire una risposta alla domanda di partenza, non volendo affrontare l'ultimo cambio di rotta, direi:

dopo avere valorizzato con numeri a caso l'intervallo G5:K6 e

lasciando libera (vuota) la prima colonna (che può essere poi nascosta),

in B1: =GRANDE((1-CONTA.SE($A1:A1;$G$5:$K$6))*$G$5:$K$6;INT(CASUALE()*(10-RIF.COLONNA(B1)))+1)

formula matriciale, da confermare con Ctrl+Maiusc+Invio, da trascinare a destra per quattro celle e in basso a volontà.

NB: il numero 10 che compare all'interno della formula non è altro che il numero dei numeri fissi (G5:K7). Variando l'intervallo si potrebbe sostituire con un CONTA.NUMERI(intervallo).

PS: ovviamente l'intervallo dei numeri fissi può essere ampliato o ridotto a piacere cambiandolo nella formula.

Answer 3

Ciao vorget,

BUONA SERA  NORMAM  IN PRIMIS TI RINGRAZIO PER IL TEMPO A ME DEDICATO  , HO FATTO COME DA TE INDICATO  ESEGUENDO ALLA LETTERA TUTTI I VARI PROCEDIMENTI MA NON MI APPARE NULLA HO ANCHE SCARICATO IL FILE DI PROVA  MA NON RISULTA CHE SI SIA UNA MACRO  FORSE SBAGLIO QUALCOSA? 

Riprova di scaricare il file Vorget2018/0206.xlsm.

Aprendo il file, vedrai qualcosa del genere:

Faccendo cllc sul pulsante rosa, vedrai una modifica nella selezione dei valori nell'intervallo G5:K6; ad esempio:

Infatti, la selezione sarà cambiata ad ogni clic del pulsante, ossia ad ogni esecuzione della macro.

===

Regards,

Norman

Answer 4

BUONA SERA  NORMAM  IN PRIMIS TI RINGRAZIO PER IL TEMPO A ME DEDICATO  , HO FATTO COME DA TE INDICATO  ESEGUENDO ALLA LETTERA TUTTI I VARI PROCEDIMENTI MA NON MI APPARE NULLA HO ANCHE SCARICATO IL FILE DI PROVA  MA NON RISULTA CHE SI SIA UNA MACRO  FORSE SBAGLIO QUALCOSA?

Answer 5

Ciao vorget,

buona sera a tutti spero che qualcuno mi potrà aiutare  

vorrei generare dei numeri casuali senza ripetizione scelti da elenco 

in un riquadro" g5:k6"  ho creato i numeri da scegliere invece in "a1:e20" vengono messi i numeri  selezionati casuali ,ma qui viene il problema i numeri a volte nelle righe si doppiano . come faccio a

eliminare il problema  vi allego l'immagine  affinché possa essere più esplicito

" utilizzo office 2007 enterprise

Prova qualcosa del genere:

• Alt+F11 per aprire l'editor di VBA
• Alt+IM per inserire un nuovo modulo di codice
• Nel nuovo modulo vuoto, incolla il seguente codice:

'--------->>

Public Sub Tester()

    Dim WB As Workbook

    Dim SH As Worksheet

    Dim srcRng As Range, destRng As Range

    Dim arrIn As Variant, arrShuffled() As Variant

    Dim arrUnique() As Variant

    Const sFoglio As String = "Foglio1"                           '<<=== Modifica

    Const sIntervalloSorgente As String = "A1:E17"         '<<=== Modifica

    Const sIntervalloDestinazione As String = "G5:K6"    '<<=== Modifica

    Set WB = ThisWorkbook

    Set SH = WB.Sheets(sFoglio)

    With SH

        Set srcRng = .Range(sIntervalloSorgente)

        Set destRng = .Range(sIntervalloDestinazione)

    End With

    arrIn = srcRng.Value

    arrUnique = SortedUniqueList(arrIn)

    arrShuffled = ShuffleArray(arrUnique)    ' SortedUniqueList(arrIn))

    For i = 1 To UBound(arrShuffled)

        destRng.Cells(i).Value = arrShuffled(i)

    Next i

XIT:

End Sub

'--------->>

Public Function SortedUniqueList(V As Variant)

    Dim oSortedUniqueList As Object

    Dim arrOut() As Variant

    Dim iVal As Long

    Dim i As Long, J As Long

    Set oSortedUniqueList = CreateObject("System.Collections.Sortedlist")

    With oSortedUniqueList

        For i = LBound(V) To UBound(V)

            For J = 1 To UBound(V, 2)

                iVal = V(i, J)

                If Not IsEmpty(iVal) Then

                    If Not .ContainsKey(iVal) Then

                        .Add Key:=iVal, Value:=i

                    End If

                End If

            Next J

        Next i

        ReDim arrOut(1 To .Count)

        For i = 0 To .Count - 1

            arrOut(i + 1) = .GetKey(i)

        Next i

    End With

    SortedUniqueList = arrOut

End Function

'--------->>

Public Function ShuffleArray(InArray() As Variant) As Variant()

    Dim N As Long

    Dim Temp As Variant

    Dim J As Long

    Dim Arr() As Variant

    Randomize

    L = UBound(InArray) - LBound(InArray) + 1

    ReDim Arr(LBound(InArray) To UBound(InArray))

    For N = LBound(InArray) To UBound(InArray)

        Arr(N) = InArray(N)

    Next N

    For N = LBound(InArray) To UBound(InArray)

        J = CLng(((UBound(InArray) - N) * Rnd) + N)

        Temp = Arr(N)

        Arr(N) = Arr(J)

        Arr(J) = Temp

    Next N

    ShuffleArray = Arr

End Function

'<<========= 

• Alt+Q per chiudere l'editor di VBA e tornare a Excel
• Salva il file con l’estensione xlsm
• Alt+F8 per aprire  la finestra di gestione delle macro
• Seleziona Tester
• Esegui

Potresti scaricare il mio file di prova Vorget2018/0206.xlsm

Con questo file, per modificare, a caso, il contenuto dell'intervallo G5:K6, esegui la macro Tester oppure premi il pulsante rosa,

===

Regards,

Norman