MacroFacili: Distribuzione casuale di nomi

Questa funzione mostra come sia possibile scrivere una funzione di matrice che riporta i valori di un elenco in modo casuale su un intervallo di celle.

Nell'esempio a lato si può vedere il risultato della funzione:

l'elenco a sinistra viene ripartito nella celle a destra;
i nominativi vengono riportati fino al riempimento della matrice, eventuali altri vengono tralasciati;
se il numero di nominativi è inferiore alle celle da riempire le rimanenti saranno vuote;
possono esserci anche nomi ripetuti, vengono ripetuti anche nella matrice.

Function DistribuzioneCasuale(Origine As Range) As Variant
  Dim i As Integer, iC As Integer, iR As Integer, nrRows As Integer, nrCols As Integer

  'determina le dimensioni dell'area di destinazione
  With Application.Caller
    nrRows = .Rows.Count
    nrCols = .Columns.Count
  End With

  'crea il vettore dei risultati e impposta tutte le celle a ''
  Dim arrRes() As Variant
  ReDim arrRes(nrRows - 1, nrCols - 1)

  R = LBound(arrRes, 1)
  While (R <= UBound(arrRes, 1))
    C = LBound(arrRes, 2)
    While (C <= UBound(arrRes, 2))
      arrRes(R, C) = ""
      C = C + 1
    Wend
    R = R + 1
  Wend

  'ditribuisce i valori dell'elenco nella matrice
  NrLiberi = (nrRows * nrCols)
  For Each Elemento In Origine
    i = Int((nrRows * nrCols) * Rnd) + 1
    ConvertiInRC i:=i, iC:=iC, iR:=iR, nrC:=nrCols, nrR:=nrRows

    ' verifica che la cella sia vuota altrimenti riprova
    While Not (arrRes(iR, iC) = "")
      i = Int((nrRows * nrCols) * Rnd) + 1
      ConvertiInRC i:=i, iC:=iC, iR:=iR, nrC:=nrCols, nrR:=nrRows
    Wend

    arrRes(iR, iC) = Elemento

    ' verifica che non siano tutte occupate le celle
    NrLiberi = NrLiberi - 1
    If (NrLiberi <= 0) Then
      Exit For
    End If
  Next Elemento

  DistribuzioneCasuale = arrRes
End Function

' converte l'indice in coordinate di riga e colonna
Sub ConvertiInRC(i As Integer, ByRef iC As Integer, ByRef iR As Integer, _
                  nrC As Integer, nrR As Integer)
  i = i Mod (nrC * nrR)
  iR = Int(i / nrC)
  iC = i Mod nrC
End Sub

L'esempio completo é scaricabile da questo link: Es382.xlsm (a questo link le info per attivare le macro se risultano bloccate)

Gli esempi contenuti nel sito sono per uso personale, non é consentito l'uso professionale, commerciale o la riproduzione senza autorizzazione.

Per dubbi o domande potete scriverci a domande@macrofacili.it, sulla nostra pagina FB MacroFacili.it o sul gruppo FB Excel, macro e formule.