estrarre righe casuali da un elenco excell

[Claudio Designo]

Salve

ho la necessità di estrarre 600 righe, in maniera casuale, con estrazione senza ripetizione, da un elenco di 22.000 righe e 4 colonne (nome, indirizzo, cap, città)
mi hanno consigliato la macro appresso riportata ma non funziona. Chi può aiutarmi? utilizzo il buon vecchio excel 2007

Sub Combine()
Dim NumSheets As Integer
Dim NumRows As Integer

' Change the value of NumSheets to equal the number of sheets you wish to combine
NumSheets = 1
' Change the value of NumRows to equal the number of rows in each sheet
NumRows = 600

Worksheets(1).Select
Sheets.Add
ActiveSheet.Name = "Consolidated"
For X = 1 To NumSheets
Worksheets(X + 1).Select
Rows("2:" & NumRows).Select
Selection.Copy
Worksheets("Consolidated").Select
ActiveSheet.Paste
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
Worksheets(X + 1).Select
Range("A1").Select
Next X
Worksheets("Consolidated").Select
Range("A1").Select
End Sub

[plinius]

Il 04/02/2013 19:19, Claudio Designo ha scritto:
> Salve
>
> ho la necessit� di estrarre 600 righe, in maniera casuale, con estrazione senza ripetizione, da un elenco di 22.000 righe e 4 colonne (nome, indirizzo, cap, citt�)
> mi hanno consigliato la macro appresso riportata ma non funziona. Chi pu� aiutarmi? utilizzo il buon vecchio excel 2007

>
> Sub Combine()
> Dim NumSheets As Integer
> Dim NumRows As Integer
>
> ' Change the value of NumSheets to equal the number of sheets you wish to combine
> NumSheets = 1
> ' Change the value of NumRows to equal the number of rows in each sheet
> NumRows = 600
>
> Worksheets(1).Select
> Sheets.Add
> ActiveSheet.Name = "Consolidated"
> For X = 1 To NumSheets
> Worksheets(X + 1).Select
> Rows("2:" & NumRows).Select
> Selection.Copy
> Worksheets("Consolidated").Select
> ActiveSheet.Paste
> Selection.End(xlDown).Select
> ActiveCell.Offset(1, 0).Select
> Worksheets(X + 1).Select
> Range("A1").Select
> Next X
> Worksheets("Consolidated").Select
> Range("A1").Select
> End Sub
>

Puoi farlo senza macro.
Se i tuoi dati sono (per esempio) in A2:D22001, attribuisci al range
A2:D22001 il nome "rng"
Quindi in attribuisci al range G2:G301 il nome "est".
In G2 inserisci =CASUALE()
in H2 inserisci
=INDICE(rng;RANGO($G2;est);RIF.COLONNA()-RIF.COLONNA(est))e trascina
questa formula a destra fino a K2
Adesso trascina il range G2:K2 in basso fino alla riga 301

Ecco in H2:K301 le tue 300 estrazioni senza ripetizioni.

Ciao,
E.

[plinius]

Acc... scusa ho sbagliato.
Fai conto che non abbia detto niente, ora non posso, ma pi� tardi correggo.
Ciao,
E.

[plinius]

Il 04/02/2013 20:11, plinius ha scritto:

Allora, eccomi.

Il range da definire con il nome"est" � G2:G22001, interamente riempito
con la formula =CASUALE()
Tutto il resto (H2:K301) rimane inalterato rispetto a quanto detto prima.

Ciao,
E.

[Bruno Campanini]

It happens that Claudio Designo formulated :
> Salve
>
> ho la necessitￜ di estrarre 600 righe, in maniera casuale, con estrazione

> senza ripetizione, da un elenco di 22.000 righe e 4 colonne (nome, indirizzo,

> cap, cittￜ) mi hanno consigliato la macro appresso riportata ma non funziona.
> Chi puￜ aiutarmi? utilizzo il buon vecchio excel 2007

Questa genera 600 numeri casuali unici
compresi fra 1 e 22000
====================================
Public Sub Eran600GiovaniEforti()
Dim extRows As New Collection, S As Long
Dim TargetRange As Range, i As Long
Set TargetRange = [BC!K1]
Do
S = Int(22000 * Rnd + 1)
On Error Resume Next
extRows.Add S, CStr(S)
On Error GoTo 0
Loop Until extRows.count = 600
For i = 1 To extRows.count
TargetRange(i) = extRows(i)
Next
End Sub
====================================

Bruno

[r]

in A2 questa formula:
=PICCOLO(SE(1-CONTA.SE(A$1:A1;RIF.RIGA(INDIRETTO("1:"&20000)));RIF.RIGA(INDIRETTO("1:"&20000)));INT(CASUALE()*(20000-CONTA.NUMERI(A$1:A1)))+1)
da confermare con ctrl+maiusc+invio e trascinare in basso fino a necessità (nel tuo caso per 600 righe)

presa da qui:
https://sites.google.com/site/e90e50fx/home/poker-challenge-in-excel

saluti
r

[Bruno Campanini]

r laid this down on his screen :

> in A2 questa formula:
> =PICCOLO(SE(1-CONTA.SE(A$1:A1;RIF.RIGA(INDIRETTO("1:"&20000)));RIF.RIGA(INDIRETTO("1:"&20000)));INT(CASUALE()*(20000-CONTA.NUMERI(A$1:A1)))+1)

> da confermare con ctrl+maiusc+invio e trascinare in basso fino a necessitￜ

> (nel tuo caso per 600 righe)

Con qualche doppione... una decina su 600.
Non ne ho ancora trovata una che funzioni per il verso giusto.

Bruno

[r]

Il giorno martedì 5 febbraio 2013 22:23:13 UTC+1, Bruno Campanini ha scritto:
> r laid this down on his screen :
>
> > in A2 questa formula:
>
> > =PICCOLO(SE(1-CONTA.SE(A$1:A1;RIF.RIGA(INDIRETTO("1:"&20000)));RIF.RIGA(INDIRETTO("1:"&20000)));INT(CASUALE()*(20000-CONTA.NUMERI(A$1:A1)))+1)
>

> > da confermare con ctrl+maiusc+invio e trascinare in basso fino a necessità

>
> > (nel tuo caso per 600 righe)
>
>
>
> Con qualche doppione... una decina su 600.
>
> Non ne ho ancora trovata una che funzioni per il verso giusto.
>
>
>
> Bruno

non so dove sbagli, forse la traduzione sebbene al link ci sia anche la formula in inglese ... controlla va ...
in A2 questa:
=SMALL(IF(1-COUNTIF(A$1:A1,ROW(INDIRECT("1:"&20000))),ROW(INDIRECT("1:"&20000))),INT(RAND()*(20000-COUNT(A$1:A1)))+1)

da confermare con ctrl+shift+enter e trascinare in basso ...

se ottieni ancora doppioni prova a condividere il file, io con quella formula i doppioni li vedo solo dopo la terza grappa
saluti
r

[r]

io con n a 20000 non l'ho provata ... il mio pc non può farcela, magari sul tuo ...

Sub test()
Dim rng As Excel.Range
Dim i As Long

Const n As Long = 100
'Worksheets.Add
Set rng = [a2]
rng.FormulaArray = _
"=SMALL(IF(1-COUNTIF(A$1:A1,ROW" & _
"(INDIRECT(""1:""&" & _
n & "))),ROW(INDIRECT(""1:""&" & _
n & "))),INT(RAND()*(" & _
n & "-COUNT(A$1:A1)))+1)"
rng.Copy rng.Offset(1).Resize(Int(n / 2))

For i = 1 To n
If VBA.IsNumeric(Application.Mode(rng.Resize(Int(n / 2) + 1))) Then
MsgBox "Uffa ci sono doppioni!"
Exit Sub
End If
Next
MsgBox "Macchè, funziona!"
End Sub

r

[r]

Il giorno martedì 5 febbraio 2013 23:44:27 UTC+1, r ha scritto:
mi sembrava troppo veloce :-)

ho dimenticato di ricalcolare

prima correzione al test ...

Sub test()
Dim rng As Excel.Range
Dim i As Long

Const n As Long = 100
'Worksheets.Add
Set rng = [a2]
rng.FormulaArray = _
"=SMALL(IF(1-COUNTIF(A$1:A1,ROW" & _
"(INDIRECT(""1:""&" & _
n & "))),ROW(INDIRECT(""1:""&" & _
n & "))),INT(RAND()*(" & _
n & "-COUNT(A$1:A1)))+1)"
rng.Copy rng.Offset(1).Resize(Int(n / 2))

For i = 1 To n

rng.Resize(Int(n / 2) + 1).Calculate

[r]

terza e ultima:

Sub test()
Dim rng As Excel.Range, i As Long

Const n As Long = 100
'Worksheets.Add
Set rng = [a2]
rng.FormulaArray = _
"=SMALL(IF(1-COUNTIF(A$1:A1,ROW" & _
"(INDIRECT(""1:""&" & _
n & "))),ROW(INDIRECT(""1:""&" & _
n & "))),INT(RAND()*(" & _
n & "-COUNT(A$1:A1)))+1)"
rng.Copy rng.Offset(1).Resize(Int(n / 2))

Set rng = rng.Resize(Int(n / 2) + 1)

For i = 1 To n

rng.Calculate
If VBA.IsNumeric(Application.Mode(rng)) Then

MsgBox "Uffa ci sono doppioni!"
Exit Sub
End If
Next
MsgBox "Macchè, funziona!"
End Sub

r

[r]

Il giorno martedì 5 febbraio 2013 01:30:45 UTC+1, Bruno Campanini ha scritto:
> It happens that Claudio Designo formulated :
>
> > Salve
>
> >
>

> > ho la necessità di estrarre 600 righe, in maniera casuale, con estrazione

>
> > senza ripetizione, da un elenco di 22.000 righe e 4 colonne (nome, indirizzo,
>

> > cap, città) mi hanno consigliato la macro appresso riportata ma non funziona.
>
> > Chi può aiutarmi? utilizzo il buon vecchio excel 2007

>
>
>
> Questa genera 600 numeri casuali unici
>
> compresi fra 1 e 22000
>
> ====================================
>
> Public Sub Eran600GiovaniEforti()
>
> Dim extRows As New Collection, S As Long
>
> Dim TargetRange As Range, i As Long
>
> Set TargetRange = [BC!K1]
>
> Do
>
> S = Int(22000 * Rnd + 1)
>
> On Error Resume Next
>
> extRows.Add S, CStr(S)
>
> On Error GoTo 0
>
> Loop Until extRows.count = 600
>
> For i = 1 To extRows.count
>
> TargetRange(i) = extRows(i)
>
> Next
>
> End Sub
>
> ====================================
>
>
>
> Bruno

accipicchia ... ancora forza bruta poco performante ...

questa è una udf che restituisce una matrice di ListCoun elementi diversi e casuali nell'intervallo bottom-top

Function GetRandList_g(ListCount As Long, Bottom As Long, Top As Long)
Dim x As Long, i As Long, z As Long, m As Long

If Top < Bottom Or ListCount < 1 Then
GetRandList_g = Null
Exit Function
End If

m = Top - Bottom + 1
ReDim tb(1 To m)

For i = 1 To m
tb(i) = i + Bottom - 1
Next

For i = 1 To m
x = Int(Rnd() * m) + 1
z = tb(x)
tb(x) = tb(i)
tb(i) = z
Next

If ListCount < m Then
ReDim Preserve tb(1 To ListCount)
End If

GetRandList_g = Application.Transpose(tb)
End Function


saluti
r

[Bruno Campanini]

r wrote on 06-02-13 :

> accipicchia ... ancora forza bruta poco performante ...

Ma va' a cagare!

Bruno

[r]

Il giorno mercoledì 6 febbraio 2013 10:46:27 UTC+1, Bruno Campanini ha scritto:
> r wrote on 06-02-13 : > accipicchia ... ancora forza bruta poco performante ... Ma va' a cagare! Bruno

:-)

i tempi aumentano più ti avvicini al limite di 22000 ... non l'ho provata ma scommetto che se imposti 22000 risultati rischi di passarci i minuti li ad aspettare.

...
Loop Until extRows.count = 22000
...

io vado a cagare ... però rimane il fatto che la routine è senza algoritmo

[r]

Il giorno mercoledì 6 febbraio 2013 12:29:48 UTC+1, r ha scritto:

non ho resistito e l'ho provata ... così:

Public Sub Eran600GiovaniEforti()
Dim extRows As New Collection, S As Long
Dim TargetRange As Range, i As Long

Dim d As Double
'Set TargetRange = [BC!K1]
d = Timer

Do
S = Int(22000 * Rnd + 1)
On Error Resume Next
extRows.Add S, CStr(S)
On Error GoTo 0

Loop Until extRows.Count = 22000
'For i = 1 To extRows.Count
' TargetRange(i) = extRows(i)
'Next
Debug.Print Timer - d
End Sub

restituisce 0,640625
e 1,71875 con 50000 numeri ...

non sono minuti (mi sbagliavo) solo secondi ... il giudizio rimane identico

[r]

Il giorno mercoledì 6 febbraio 2013 12:38:07 UTC+1, r ha scritto:

questo il dettaglio dei fallimenti ... con 1.638.400 numeri si hanno 11.210.721 loop a vuoto

Public Sub vaiacagare_02()
Dim S As Long
Dim i As Long, t As Long, x As Long, y As Long
Dim v() As Boolean, d As Double
x = 100
Randomize
For y = 1 To 15
d = Timer
ReDim v(1 To x)
Do
S = Int(x * Rnd + 1)
If v(S) Then
t = t + 1
Else
v(S) = True
i = i + 1
End If
Loop Until i = x
Debug.Print "Numero di fallimenti con " & _
Format(x, "#,##0") & " numeri: " & _
Format(t, "#,##0") & _
" su " & _
Format(i + t, "#,##0") & " tempo: " & Timer - d
t = 0
i = 0
x = x * 2
Next
End Sub

[Bruno Campanini]

r has brought this to us :
> Il giorno mercoledￜ 6 febbraio 2013 10:46:27 UTC+1, Bruno Campanini ha

> scritto:
>> r wrote on 06-02-13 : > accipicchia ... ancora forza bruta poco performante
>> ... Ma va' a cagare! Bruno
>
> :-)
>

> i tempi aumentano piￜ ti avvicini al limite di 22000 ... non l'ho provata ma

> scommetto che se imposti 22000 risultati rischi di passarci i minuti li ad
> aspettare.
>
> ...
> Loop Until extRows.count = 22000
> ...

600/22000 0.015
22000/22000 2.9
50000/1000000 8.88
100000/1000000 68
... secondi!

> io vado a cagare ... perￜ rimane il fatto che la routine ￜ senza algoritmo

Bravo falla tutta e non mi romper piￜ i coglioni.

Bruno

[r]

Il giorno mercoledì 6 febbraio 2013 18:16:46 UTC+1, Bruno Campanini ha scritto:
Bravo falla tutta e non mi romper più i coglioni. Bruno

Adesso esageri, dovresti darti un contegno
Hai sbagliato a scrivere la formula scrivendo poi che non funziona ... invece funziona. Dovresti chiedere scusa e correggere il tiro. Non sparare cazzate e poi lasciarle li.
La routine fa schifo ... mio figlio di 7 anni la scriverebbe meglio ... prova a chiederlo agli altri se sentirtelo dire da me ti rompe i coglioni

[plinius]

Ditemi che state scherzando!

[r]

Il giorno mercoledì 6 febbraio 2013 23:15:29 UTC+1, plinius ha scritto:
> Ditemi che state scherzando!

nel dire cosa?
che la routine fa schifo oppure che non è nemmeno buono di trascrivere una formula?

[plinius]

Il 07/02/2013 00:00, r ha scritto:

> Il giorno mercoled� 6 febbraio 2013 23:15:29 UTC+1, plinius ha scritto:
>> Ditemi che state scherzando!
>
> nel dire cosa?

> che la routine fa schifo oppure che non � nemmeno buono di trascrivere una formula?
>

Nei toni.
� possibile esprimere le proprie opinioni anche senza bisticciare... mi
sa che devo aggiornare il pentalogo...

[r]

Il giorno giovedì 7 febbraio 2013 00:05:55 UTC+1, plinius ha scritto:

>
> Nei toni.
>

spero non ti stia rivolgendo a me ... ma vuoi litigare?
:-)
r

[r]

ma toglimi una curiosità ... ma la formula funziona?
(che quello mi fa venire i dubbi)
e la routine è vero che fa schifo?
(su questo no ...)
no giusto per sapere ...

[plinius]

Il 07/02/2013 00:22, r ha scritto:

> Il giorno gioved� 7 febbraio 2013 00:05:55 UTC+1, plinius ha scritto:
>
>>
>> Nei toni.
>>
>
> spero non ti stia rivolgendo a me ... ma vuoi litigare?
> :-)
> r
>

Rivolgersi all'uno o all'altro significa prendere posizione e diventare
parte in causa. Non credo sia quello di cui c'� bisogno.
Dico solo che Bruno ha (ma non da ora) modi bruschi, cosa che tu sai
perfettamente, certo meglio di me, tant'� che spesso lo hai apostrofato
con l'appellativo di "orso"... ovviamente bruno.
Se quei toni non ti stanno bene (e posso capirlo) basta non replicare
con toni altrettanto duri.
A volte tacere � un'arte, non credi anche tu?
Ciao,
E.


____________________________________________
P.S.: non riuscirai mai a farmi litigare :-)

[plinius]

Il 07/02/2013 00:38, r ha scritto:
> Il giorno gioved� 7 febbraio 2013 00:22:31 UTC+1, r ha scritto:

>> Il giorno gioved� 7 febbraio 2013 00:05:55 UTC+1, plinius ha scritto:
>>
>>
>>
>>>
>>
>>> Nei toni.
>>
>>>
>>
>>
>>
>> spero non ti stia rivolgendo a me ... ma vuoi litigare?
>>
>> :-)
>>
>> r
>

> ma toglimi una curiosit� ... ma la formula funziona?

> (che quello mi fa venire i dubbi)

> e la routine � vero che fa schifo?

> (su questo no ...)
> no giusto per sapere ...
>

La formula funziona perfettamente e, a mio parere, � geniale.
Dal punto di vista pratico per�, per un grande numero di estrazioni, �
pesantissima e nel confronto con una sub in VBA la vedo perdente.
Contro una qualunque sub, compresa quella di Bruno, che (ne convengo)
non � esattamente il massimo di efficienza.

[r]

Il giorno giovedì 7 febbraio 2013 00:39:10 UTC+1, plinius ha scritto:

> Rivolgersi all'uno o all'altro significa prendere posizione e diventare
>

> parte in causa. Non credo sia quello di cui c'è bisogno.

ma figurati ... io non ti voglio mica dalla mia parte :-)

però un giudizio sulla routine e sulla formula potresti anche darlo ...

[r]

ok mi ritengo soddisfatto, grazie
r