date random

Hai un problema con Excel?

Nuova discussione

date random
di hackprio (utente non iscritto) data: 20/01/2013 17:39:29
ciao a tutti è da poco che ho iniziato a usare vba e vi scrivo perche non riesco a risolvere un problema.. in pratica stavo creando un macro in grado di creare date casuali ma con dei parametri (tipo: mese d'inizio, quante date per ogni mese,quanti mesi e date totali)... funziona tutto solo che excel va in palla con il formato delle date ovvero meglio vi faccio vedere i risultati cosi capite meglio..
numero data
1 17/6/2012
2 21/6/2012
3 23/6/2012
4 06/01/2012
5 06/02/2012
6 06/06/2012
7 19/6/2012
8 17/6/2012
9 06/08/2012
10 06/07/2012
11 28/6/2012
12 20/7/2012
13 28/7/2012
14 07/06/2012
15 07/02/2012
16 20/7/2012
17 07/09/2012
18 17/7/2012
19 29/7/2012
20 24/7/2012
21 13/7/2012
22 17/7/2012
23 25/7/2012
24 29/8/2012
25 26/8/2012
26 20/8/2012
27 19/8/2012
28 17/8/2012
29 16/8/2012
30 24/8/2012
31 08/04/2012
32 16/8/2012
33 14/8/2012
34 18/8/2012
35 08/03/2012
se invece non metto gli slash o tipo ne metto di piu cosi non è piu una data ottengo il risultato da me desiderato
13////////6////2012
10////////6////2012
21////////6////2012
26////////6////2012
13////////6////2012
25////////6////2012
26////////6////2012
22////////6////2012
7////////6////2012
20////////6////2012
1////////6////2012
19////////7////2012
18////////7////2012
14////////7////2012
1////////7////2012
22////////7////2012
14////////7////2012
21////////7////2012
10////////7////2012
28////////7////2012
11////////7////2012
17////////7////2012
4////////7////2012
19////////8////2012
17////////8////2012
16////////8////2012
27////////8////2012
17////////8////2012
1////////8////2012
20////////8////2012
5////////8////2012
5////////8////2012
25////////8////2012
22////////8////2012
14////////8////2012
in parole povere excel quando vede che è una data ogni tanto inverte il valore del mese con il valore dei giorni.. Perchè? cosa sbaglio? Grazie!!

P.S: So che per quanto riguarda il codice della mia macro mancano dei controlli (per esempio quando mese arriva a 12 deve tornare a 1 e aumentare di uno l'anno). Solo che non sono andato avanti quando mi sono accorto che excel mi faceva questo scherzo..

Sub datecasuali()
Dim riga, k, caselle, n, valmax, k1, mese, mesi, c As Integer
Dim m As Double
caselle = Cells(2, 2) 'numero ci celle da utilizzare
mesi = Cells(3, 2) 'mesi tot
mese = Cells(8, 3) 'mese da cui iniziare
riga = 13
c = 0  'contatore
k = 1 'contatore
k1 = 1 'contatore
valmax = 29
m = caselle / mesi
While k <= mesi
While k1 <= m
c = c + 1
n = Int(Rnd * valmax + 1)
Cells(riga, 1).HorizontalAlignment = xlLeft
Cells(riga, 1).VerticalAlignment = xlCenter
Cells(riga, 1) = c
Cells(riga, 2) = n & "/" & mese & "/2012"
Cells(riga, 2).HorizontalAlignment = xlLeft
Cells(riga, 2).VerticalAlignment = xlCenter
riga = riga + 1
k1 = k1 + 1
Wend
k1 = 0
mese = mese + 1
k = k + 1
Wend
End Sub

di Vecchio Frac data: 20/01/2013 18:13:51
Devi inserire nella cella un valore stringa formattato come data:
Cells(riga, 2) = n & "/" & mese & "/2012"

deve diventare qualcosa come:
Cells(riga, 2) = CDate(n & "/" & mese & "/2012")

Occhio che i valori siano coerenti... se n = 1 e mese = 15 il risultato che si ottiene è comunque "15/01/2012".
di hackpiro data: 20/01/2013 18:25:28
gradissimo funziona... Grazie mille :)
di Vecchio Frac data: 20/01/2013 18:29:55
Due While annidati... il codice mi piace pochino ;)
Se spieghi bene cosa vuoi che faccia, lo ottimizziamo :)
di hackpiro data: 20/01/2013 18:48:17
allora ti faccio un esempio pratico... se ho 30 celle da riempire con le date casuali e i mesi sono tre ho bisogno che mi trovi 10 date per ogni mese.. adesso mi sono accorto che c'è un problema ovvero avrei bisogno che non mi ripeta le date.. e per il riordino automatico delle date? Grazie mille per la tua disponibilita..
di Vecchio Frac data: 20/01/2013 18:54:45
Sì, ho capito qualcosa leggendo il codice, ma c'è un non so che non mi torna... se imposto 12 celle da utilizzare (B2) con dodici mesi (B3) e partendo da mese 1 (C8) il risultato sono 23 celle (e non dodici come richiesto) in cui il mese 1 compare una volta e gli altri due volte.
Per favore posta un esempio (con poche date, mettiamo 10), tutti i mesi partendo da 1, e il risultato atteso. Ricaviamo quindi una regola precisa.
La ripetizione delle date è un altro problema... devi pescare da un sacchetto di numeri univoci giorno+mese in modo che appena pescato un valore non possa più essere rimesso nel sacchetto (come la tombola).
Il riordino è facilmente fatto con un semplice Sort sull'area delle date, che se iniziano sempre in A13 otterrai con
[A13].CurrentRegion.Sort Key1=[B13], header:=xlNo

di hackpiro data: 20/01/2013 19:06:04
allora gli ho impostato mese gennaio caselle da utilizzare 10 caselle e mesi 12... me ne riempe 11..
numero data
1 05/02/2012
2 25/03/2012
3 22/04/2012
4 14/05/2012
5 26/06/2012
6 19/07/2012
7 18/08/2012
8 20/09/2012
9 07/10/2012
10 04/11/2012
11 28/12/2012

Allora riposto il codice perche l'ho implementato

Dim riga, k, caselle, n, valmax, k1, mese, mesi, c, anno As Integer
Dim m As Double
caselle = Cells(2, 2)
mesi = Cells(3, 2)
mese = Cells(8, 3)
anno = 2012
riga = 13
c = 0
k = 1
k1 = 1
valmax = 29
m = caselle / mesi
Randomize (3)
While k <= mesi
While k1 <= m
If mese = 13 Then
mese = 1
c = c + 1
n = Int(Rnd * valmax + 1)
Cells(riga, 1).HorizontalAlignment = xlLeft
Cells(riga, 1).VerticalAlignment = xlCenter
Cells(riga, 1) = c
Cells(riga, 2).NumberFormat = "m/d/yyyy"
Cells(riga, 2) = CDate(n & "/" & mese & "/" & anno)
Cells(riga, 2).HorizontalAlignment = xlLeft
Cells(riga, 2).VerticalAlignment = xlCenter
riga = riga + 1
k1 = k1 + 1
anno = anno + 1
Else
c = c + 1
n = Int(Rnd * valmax + 1)
Cells(riga, 1).HorizontalAlignment = xlLeft
Cells(riga, 1).VerticalAlignment = xlCenter
Cells(riga, 1) = c
Cells(riga, 2).NumberFormat = "m/d/yyyy"
Cells(riga, 2) = CDate(n & "/" & mese & "/" & anno)
Cells(riga, 2).HorizontalAlignment = xlLeft
Cells(riga, 2).VerticalAlignment = xlCenter
riga = riga + 1
k1 = k1 + 1
End If
Wend
k1 = 0
mese = mese + 1
k = k + 1
Wend
End Sub

di Vecchio Frac data: 20/01/2013 19:21:25
Io ottengo 19 celle riempite :)
L'errore è in quel
k1 = 0
dopo il Wend perchè così ogni sottociclo viene eseguito almeno due volte. Metti k1 = 1.
Inoltre è concettualmente errato questo:
Cells(riga, 2).NumberFormat = "m/d/yyyy"
Cells(riga, 2) = CDate(n & "/" & mese & "/" & anno)
perchè prima imposti il formato data a mese giorno anno e poi converti la data come giorno mese anno.

di Vecchio Frac data: 20/01/2013 19:44:02
Andando con ordine, prova il codice seguente.
Adesso bisogna fare in modo che si possa impostare, come da tua richiesta iniziale, quante date per ogni mese, il che può entrare in conflitto con i parametri precedenti (quante celle da riempire e quanti mesi a disposizione).

Option Explicit

Sub datecasuali()
Dim riga As Integer, caselle As Integer, n As Integer, mese As Integer, mesi As Integer, anno As Integer
Dim m As Integer, num As Integer
    Randomize Timer
    caselle = [B2]
    mesi = [B3]
    mese = [C8]
    anno = 2012
    riga = 13
    m = caselle / mesi
    
    [A13].CurrentRegion.ClearContents

    For riga = 1 To caselle
        For num = 1 To m
            Cells(riga + 13, 1) = riga
            n = Estratto
            If Not IsDate(n & "/" & mese & "/" & anno) Then
                n = 1
            End If
            Cells(riga + 13, 2) = CDate(n & "/" & mese & "/" & anno)
        Next
        mese = mese + 1
        If mese > 12 Then
            mese = 1
            anno = anno + 1
        End If
    Next
    
    With [A13].CurrentRegion.Cells
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlCenter
    End With
End Sub

Private Function Estratto() As Integer
' variabile statica per conservare i valori
Static numeri(31) As Integer
Dim i As Integer, e As Integer, n As Integer
    If numeri(0) = 0 Then ' se la matrice non è ancora inizializzata
        For i = 1 To 31
            numeri(i) = i
        Next
        numeri(0) = 31 ' il numero massimo per la randomizzazione
    End If
    Randomize
    'estrai un numero entro il massimo
    e = Int(Rnd() * numeri(0) + 1)
    'scambi le posizioni, per non estrarlo più
    i = numeri(numeri(0))
    numeri(numeri(0)) = numeri(e)
    numeri(e) = i
    numeri(0) = numeri(0) - 1
    Estratto = e
End Function

di hackpiro data: 20/01/2013 19:46:53
grazie si hai ragione che stupido non so perchè avevo messo k1=0.. Cmq scusa l'ignoranza riesci a farmi capire come devo utilizzare il random affinche non si ripetano le date? grazie
di Vecchio Frac data: 20/01/2013 20:00:42
A questo pensa la Function di servizio "Estratto" che si preoccupa di pescare un numero tra 1 e 31 senza ripetizioni (come nella tombola) e lo assegna alla variabile "n".
Veramente non funziona benissimo perchè vengono sì estratti dei numeri senza ripetizioni, ma nell'ambito dell'intero anno (ogni giorno è diverso) mentre tu vorresti giorni diversi dentro lo stesso mese.
Vedo adesso di correggere ^_^
di hackpiro (utente non iscritto) data: 20/01/2013 20:41:05
scusa se ti disturbo per colpa della mi ignoranza... riesci a spiegarmi questo pezzo di codice? grazie :D
If Not IsDate(n & "/" & mese & "/" & anno) Then n = 1 End If
di Vecchio Frac data: 20/01/2013 21:15:12
La Function Estratto ritorna un numero in un range di valori tra 1 e 31.
Ma nel caso di febbraio ciò sarebbe errato...
allora faccio fare un controllo e se la data risultante non è valida (31 febbraio! o 30 febbraio!) allora assume che sia l'1 febbraio.
Non è un metodo che mi piace perchè è rozzo e approssimativo...
inoltre ci son altre amenità (intese come errori) nel mio codice che non mi piacciono e a cui cercherò di rimediare.

di Vecchio Frac data: 20/01/2013 21:35:13
Questa nuova versione è più pulita :)
Dimmi se fa quel che ti aspetti, altrimenti mi devi ridefinire la regola.

Option Explicit

Sub datecasuali()
Dim riga As Integer, caselle As Integer, n As Integer, mese As Integer, mesi As Integer, anno As Integer
Dim m As Integer, num As Integer
Dim s As String, gio As Integer, mes As Integer

    Randomize Timer
    caselle = [B2]
    mesi = [B3]
    mese = [C8]
    anno = 2012
    riga = 13
    m = caselle / mesi
    
    [A13].CurrentRegion.ClearContents

    For riga = 1 To caselle
        For num = 1 To m
            Cells(riga + 12, 1) = riga
            
            mes = Int(Rnd * mesi) + 1
            Do
                gio = Int(Rnd * Day(DateSerial(anno, mes + 1, 0))) + 1
            Loop Until InStr(s, Format(gio, "00") & "/" & Format(mes, "00")) = 0
            s = s & Format(gio, "00") & "/" & Format(mes, "00") & " "
            
            Cells(riga + 12, 2) = CDate(gio & "/" & mes & "/" & anno)
        Next
        mese = mese + 1
        If mese > 12 Then
            mese = 1
            anno = anno + 1
        End If
    Next
    
    With [A13].CurrentRegion.Cells
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlCenter
    End With
    
    [B13:B50].Sort key1:=[B13], header:=xlNo
End Sub

di hackpiro data: 22/01/2013 13:21:27
purtroppo devo dirti che non funziona proprio.. Se faccio tre mesi, caselle dieci, inizio mese settembre (9), mi da questo risultato:

1 09/01/2012
2 14/01/2012
3 25/01/2012
4 01/02/2012
5 16/02/2012
6 26/02/2012
7 31/03/2012
8 27/01/2013
9 07/02/2013
10 24/03/2013
di Vecchio Frac data: 22/01/2013 14:27:02
Lo immaginavo, il risultato atteso come dovrebbe essere?
di hackpiro data: 22/01/2013 14:42:47
il mio funziona solo che ho il problema delle ripetizioni
1 07/09/2012
2 15/09/2012
3 25/09/2012
4 03/10/2012
5 16/10/2012
6 22/10/2012
7 06/11/2012
8 26/11/2012
9 28/11/2012
Casualmente qua non le ha ripetute.. :D
di Vecchio Frac data: 22/01/2013 15:08:51
Non le ha ripetute, ma non ha compilato dieci celle, bensì nove :)
Ti aspetteresti un settembre o un novembre in più?
Il problema è interessante e mi piacerebbe risolverlo, solo che ho solo dei ritagli di tempo :(

di HarryBosch data: 22/01/2013 16:34:03
Partendo dalla base proposta da Vecchio Frac ho sfornato questo codice anche se non sono per niente soddisfatto.
Ho lasciato tutte le variabili dichiarate in modo da renderlo più capibile, ma se ho tempo vedo di alleggerirlo un pò...

Però dovrebbe fare quanto richiesto, almeno da quanto mi sembra d'aver capito, anche se ancora non è chiaro cosa ci si aspetta quando il rapporto tra caselle totale e numero dei mesi non è ottimale.

Option Explicit

Sub datecasuali()
  Dim caselle As Integer, mesi As Integer, mese As Integer, anno As Integer, rip As Integer
    Dim u As Integer, n As Integer
    Dim riga As Integer, g_min As Integer, g_max As Integer
    Dim c As Integer, gio As Integer, n_anno As Integer, a As Integer, m As Integer
    Dim cas(), num As Variant, t As Boolean

    caselle = [B2]
    mesi = [B3]
    mese = [C8]
    anno = 2012
    riga = 13

    m = caselle / mesi

    [A13].CurrentRegion.ClearContents

    For rip = 0 To mesi - 1

        n_anno = mese + rip
        If n_anno > 12 Then
            n_anno = 1 + a
            anno = anno + 1
            a = a + 1
        End If

        u = Day(DateSerial(anno, n_anno + 1, 0))
        g_min = 1
        g_max = u
        Randomize (1)

        For n = 1 To m
            ReDim cas(n)
            c = c + 1

            Do
                gio = Int(Rnd() * (g_max - g_min + 1)) + g_min

                For Each num In cas
                    If gio = num Then t = True: Exit Sub
                Next

            Loop Until t = False
            cas(n) = gio

            Cells(c + 12, 1) = riga
            Cells(riga, 2) = CDate(gio & "/" & n_anno & "/" & anno)
            riga = riga + 1
        Next n

    Next

    With [A13].CurrentRegion.Cells
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlCenter
    End With

    [B13:B50].Sort key1:=[B13], Header:=xlNo
End Sub

di HarryBosch data: 22/01/2013 16:52:04
come non detto... ho "cannato" la logica di alcune cose.
Ora dovrebbe andare...

Option Explicit

Sub datecasuali()
    Dim caselle As Integer, mesi As Integer, mese As Integer, anno As Integer, rip As Integer
    Dim u As Integer, n As Integer
    Dim riga As Integer, g_min As Integer, g_max As Integer
    Dim c As Integer, gio As Integer, n_anno As Integer, a As Integer, m As Integer
    Dim cas(), num As Variant, t As Boolean

    caselle = [B2]
    mesi = [B3]
    mese = [C8]
    anno = 2012
    riga = 13

    m = caselle / mesi

    [A13].CurrentRegion.ClearContents

    For rip = 0 To mesi - 1

        n_anno = mese + rip
        If n_anno > 12 Then
            n_anno = 1 + a
            anno = anno + 1
            a = a + 1
        End If

        u = Day(DateSerial(anno, n_anno + 1, 0))
        g_min = 1
        g_max = u
        Randomize (1)

        ReDim cas(m)
        For n = 1 To m
            c = c + 1

            Do
                gio = Int(Rnd() * (g_max - g_min + 1)) + g_min
                t = False
                For Each num In cas
                    If gio = num Then t = True: Exit For
                Next
            Loop Until t = False

            cas(n) = gio

            Cells(c + 12, 1) = riga
            Cells(riga, 2) = CDate(gio & "/" & n_anno & "/" & anno)
            riga = riga + 1
        Next n

    Next

    With [A13].CurrentRegion.Cells
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlCenter
    End With

    [B13:B50].Sort key1:=[B13], Header:=xlNo
End Sub

di hackpiro data: 22/01/2013 17:13:13
si ora funge... grazie mille! solo una cosa (anche nel mio era errato) a volte fa una casella in piu altre una in meno
come dici non è chiaro "anche se ancora non è chiaro cosa ci si aspetta quando il rapporto tra caselle totale e numero dei mesi non è ottimale". Allora non importa se in un mese c'è un giorno piu (quando il rapporto non è ottimale) l'importante è che riempa le caselle chieste dall'utente.. Comunque davvero grazie per la vostra disponibilita
di Vecchio Frac data: 22/01/2013 18:02:17
Prezioso Harry, insostituibile :)
Anche se ho un risultato curioso per
caselle = 10, mesi = 12

...a parte cominciare a numerare da 13: va corretto come
Cells(c + 12, 1) = riga - 12

ma mi riempie dodici caselle invece di dieci.
E se caselle < 7 non compila niente :(

Io poi suggerisco di inizializzare il generatore di numeri con
Randomize Timer
invece che con
Randomize (1)
ma questo è solo un dettaglio di implementazione.
di HarryBosch data: 22/01/2013 19:12:21
Verissimo Vecchio Frac!
Dopo il 2012 l'anno se ne va per conto proprio ^_^
Si, qua è da sistemare un attimo... e alla numerazione progressiva non avevo fatto caso ma hai già indicato la correzione.

Per quanto riguarda il fatto di compilare comunque tutte le caselle indicate inizialmente, bisogna capire come; ad esempio, se imposti 12 caselle e vuoi 5 mesi, ci saranno due caselle di scarto: 2 - 2 - 2 - 2 - 2 totale 10 caselle, ogni mese dei 5 con due date.
Con quale mese riempiamo le due rimaste?
Con l'ultimo mese della serie?
Con il mese successivo? (forse la soluzione migliore) 2 - 2 - 2 - 2 - 2 - 2

L'ipotesi più "complicata" sarebbe quella di redistribuire a partire dal primo mese, quindi sempre secondo l'esempio diventerebbe:
3 - 3 - 2 - 2 - 2
di Vecchio Frac data: 22/01/2013 20:35:54
Un paio di anni fa avevo da studiare una soluzione per distribuire degli studenti in gruppi omogenei su diverse giornate di corso. Ne era venuto fuori un modellino semplice ma poco flessibile. Avevo provato a parametrizzarlo ma non ne ero uscito vivo :)
L'idea di base è quella di questo problema.
Per restare nel tuo esempio: sì, bisogna ridistribuire partendo dal primo mese ma non è complicato (in teoria) infatti "basta" cominciare a riempire tutti i posti disponibili (le "caselle") di un'unità, arrivati in fondo si ricomincia fino ad esaurire il ciclo da 1 a "caselle_da_riempire". In questo modo assicuri i resti (che sono l'accumulo dei resti derivanti dalla divisione delle celle con in mesi).
Avevo chiamato il mio progettino "HOT.DOG" (Ho Trovato! Distribuzione Omogenea in Gruppi) ^_^ io ho sempre il vezzo di dare un nome significativo a tutti i miei progetti di lavoro, un acrostico che ne definisce il contenuto... EVEREST, GERVASO, PINDARO, MOSE', GENZIANA e altri che vi risparmio ^_^

di Vecchio Frac data: 23/01/2013 08:57:40
Vi prego di provare il codice seguente.
Credo di essere vicino al risultato finale.

Option Explicit

Sub datecasuali()
Dim caselle As Integer, mesi As Integer, mese As Integer, anno As Integer
Dim riga As Integer, gio As Integer, m As Integer, gruppo() As Integer, s As String
Dim num_per_gruppo As Integer, i As Integer, j As Integer, esiste As Boolean

    Randomize Timer
    
    caselle = [B2]  'elementi da dividere nei gruppi (mesi)
    mesi = [B3]     'gruppi max
    mese = [C8]     'mese di partenza
    anno = 2012     'anno di partenza
    riga = 13       'cella da cui partire per visualizzare

    num_per_gruppo = Int(caselle / mesi)    'quanti di uno stesso mese per ogni gruppo
    
    ReDim gruppo(mesi) As Integer           'quanti gruppi vengono formati
    For i = 1 To mesi
        gruppo(i) = num_per_gruppo
    Next
    For i = 1 To (caselle Mod mesi)
        gruppo(i) = gruppo(i) + 1
    Next
    
    [A13].CurrentRegion.ClearContents

    For i = 1 To mesi       'crea i gruppi
        s = ""
        m = mese + i - 1
        If m > 12 Then
            m = 1
            anno = anno + 1
        End If
        For j = 1 To gruppo(i)  'estrae tot elementi per mese
            Do
                gio = Int(Rnd * Day(DateSerial(anno, m + 1, 0)) + 1)   'calcola un giorno da 1 alla data finale del mese specificato
                esiste = InStr(s, gio)
            Loop Until Not esiste
            s = s & gio & " "

            Cells(riga, 1) = riga - 12
            Cells(riga, 2) = CDate(gio & "/" & m & "/" & anno)
            riga = riga + 1
        Next
    Next

    With [A13].CurrentRegion.Cells
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlCenter
    End With

    [B13:B50].Sort key1:=[B13], Header:=xlNo
End Sub

di HarryBosch data: 23/01/2013 10:06:21
Propongo anch'io la mia revisione; ora l'anno rimane giusto, quindi anche partendo dal 12° mese i mesi successivi ricorrono nel nuovo anno in maniera corretta.
E adesso vengono anche riempite tutte le caselle richieste inizialmente nella cella B2; l'eventuale resto viene distribuito nei primi mesi.

@Vecchio Frac
Buona la tua revisione! Dovrei anch'io passare a "controllare" le stringhe invece di utilizzare sempre i vettori e i Redim "ensionamenti".
Però anche nella tua revisione se parti da un mese finale, l'anno successivo viene continuamente incrementato ^_^
Io ho risolto con una variabile booleana: una volta passati all'anno successivo non lo incremento più.

Option Explicit

Sub datecasuali()
    Dim caselle As Integer, mesi As Integer, mese As Integer, anno As Integer, rip As Integer
    Dim u As Integer, n As Integer
    Dim riga As Integer, g_min As Integer, g_max As Integer
    Dim c As Integer, gio As Integer, n_mese As Integer, a As Integer, m As Integer
    Dim cas(), num As Variant, t As Boolean, succ As Boolean
    Dim resto As Integer, r As Integer
    Application.ScreenUpdating = False
    
    Randomize Timer
    caselle = [B2]
    mesi = [B3]
    mese = [C8]
    anno = 2012
    riga = 13

    m = Int(caselle / mesi)
    resto = caselle Mod mesi

    With [A13].CurrentRegion
        .ClearContents
        .Interior.ColorIndex = 0
    End With

    For rip = 0 To mesi - 1

        n_mese = mese + rip
        If n_mese > 12 Then
            n_mese = 1 + a
            a = a + 1
            If succ = False Then anno = anno + 1: succ = True
        End If

        u = Day(DateSerial(anno, n_mese + 1, 0))
        g_min = 1
        g_max = u

        r = 0
        If resto > 0 Then
            r = 1
            resto = resto - 1
        End If

        ReDim cas(m + r)
        For n = 1 To m + r
            c = c + 1
            Do
                gio = Int(Rnd() * (g_max - g_min + 1)) + g_min
                t = False
                For Each num In cas
                    If gio = num Then t = True: Exit For
                Next
            Loop Until t = False
            cas(n) = gio

            Cells(c + 12, 1) = riga - 12
            Cells(riga, 2) = CDate(gio & "/" & n_mese & "/" & anno)

            If rip Mod 2 = 0 Then
                Cells(riga, 2).Interior.ColorIndex = 20
            Else
                Cells(riga, 2).Interior.ColorIndex = 36
            End If

            riga = riga + 1
        Next n

    Next

    With [A13].CurrentRegion.Cells
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlCenter
    End With

    [B13:B50].Sort key1:=[B13], Header:=xlNo
    
    Application.ScreenUpdating = True
End Sub

di Vecchio Frac data: 23/01/2013 10:36:37
Molto elegante la tua revisione, pure colorizzatrice per gruppi, bravo ^_^
Ho scovato l'errore che riporti per me:
m = mese + i - 1
va portato prima del For quel
m = mese
e corretta l'istruzione in
m = m + i - 1

Ma penso che il nostro amico si possa ritenere soddisfatto della tua versione.
Anche se ancora ho problemi a impostare per esempio 65 caselle e due mesi (ed è ovvio, non ci possono essere estrazioni non ripetute in un intervallo che tenta di riempire due gruppi non meno elementi di quelli richiesti).

Comunque siccome mi sembra carino allego una revisione delle mie funzioni per generare una lista causale di numeri e estrarre da essa un numero finito di estrazioni. L'ho implementata per estrarre date diverse all'interno delle date possibili dato un mese.

L'accoppiata si può usare così, ad esempio, per generare una lista di novanta numeri e quindi estrarne cinque stando sicuri che non ci sono ripetizioni (il risultato è in finestra Immediata):
for each v in estrai(genera_lista_from_to (1,90), 5)
debug.print v;
next

Function genera_lista_from_to(min As Long, max As Long)
Dim lista() As Long, i As Integer, r1 As Long, r2 As Long, tmp As Long
'genera una lista di numeri casuali non ripetuti nel range specificato
'esempio: u = genera_lista(1, 10): For Each k In u: Print k;: Next

    Randomize Timer
    ReDim lista(0 To (max - min)) As Long
    
    'genera la lista di numeri consecutivi tra min e max
    For i = min To max
        lista(i - min) = i
    Next
    
    'quindi la disordina
    For i = 1 To 10000
        r1 = Rnd * UBound(lista)
        r2 = Rnd * UBound(lista)
        'swap
        tmp = lista(r1)
        lista(r1) = lista(r2)
        lista(r2) = tmp
    Next

    genera_lista_from_to = lista()

End Function


Function estrai(lista, num_estrazioni) As Variant
Dim i As Integer, k() As Long
'da una lista di numeri ordinata in modo casuale estrae il numero di estrazioni specificato
'restituisce Falso se si chiedono più estrazioni degli elementi contenuti
    If num_estrazioni > UBound(lista) + 1 Or num_estrazioni <= 0 Then
        estrai = Array(False)
        Exit Function
    End If
    
    ReDim k(UBound(lista))
    For i = 0 To num_estrazioni - 1
        k(i) = lista(i)
    Next
    ReDim Preserve k(i - 1)
    estrai = k()
End Function

di hackpiro data: 24/01/2013 15:26:05
grazie mille!! fa proprio quello che serve!! :D
Comunque volevo farvi alcune domande riguardanti la sintassi di vba.. gia solo con la vostra risposta sono riuscito a capire tante cose che non sapevo.. per le domande apro un altro topic? come lo intitolo? Grazie davvero! :)
di HarryBosch data: 24/01/2013 16:49:26
Se ritieni risolto il thread hai fatto bene a spuntare la discussione.
Ora, per i punti nei quali ti servono chiarimenti, puoi aprire uno o più (se riguardano argomenti diversi) thread assegnando il nome appropriato a ciascuno.
Magari creando un esempio specifico per il punto interessato.

Ad esempio, se hai un dubbio sul "sorteggio con numeri non ripetuti" (che è stato risolto attraverso un ciclo Do) apri un thread con questo titolo.
di Vecchio Frac data: 24/01/2013 18:03:01
Io l'unica osservazione che farei è che non capisco perchè
gio = Int(Rnd() * (g_max - g_min + 1)) + g_min
quando sappiamo già che g_min vale sempre 1:

gio = Int(Rnd() * g_max) + 1

no?

Vuoi Approfondire?