Hi from Italy......so sorry for my bad english.....

As you Know in Excel there is a function called ATPVBAEN.XLA , that generate
a casual combination :

here there is the excel example vba code :

Application.Run "ATPVBAEN.XLA!Random", ActiveSheet.Range("$P$2:$W$5000"),
8, 5000 _
, 7, , ActiveSheet.Range("$AI$1:$AJ$21")

and in the example above if you have this in the range A1:j:21 :

1 0,035181345

2 0,037730718

3 0,045967154

4 0,0300826

5 0,03953489

6 0,038750467

7 0,025493729

8 0,032122098

9 0,025689834

10 0,030592474

11 0,027533227

12 0,02765089

13 0,030514032

14 0,03184755

15 0,028945187

16 0,025493729

17 0,031925992

18 0,0300826

19 0,032122098

20 0,032292056



Excel return, this :

2 3 8 8 12 18 19 20

2 2 2 4 4 5 5
18

6 7 7 7 8 10 12
19

2 6 6 9 17 20 20 20

6 7 10 15 16 16 17 20

3 3 5 7 8 10 11
20

2 2 3 5 6 14 16
19




the problem is that in every rows there are repeat number :(

i don't want REPEAT number ......


can I solve it with VBA ????


TIA !

The standard way to avoid repeated numbers in a selection of random
integers is to list all of the integers that might potentially be drawn
in one column, put =RAND() in the adjacent column, sort both by the RAND
column, and read off however many integers you wish in order.

You could program this in VBA.

Jerry

Aristotele64 wrote:

Hi from Italy......so sorry for my bad english.....

As you Know in Excel there is a function called ATPVBAEN.XLA , that generate
a casual combination :

here there is the excel example vba code :

Application.Run "ATPVBAEN.XLA!Random", ActiveSheet.Range("$P$2:$W$5000"),
8, 5000 _
, 7, , ActiveSheet.Range("$AI$1:$AJ$21")

and in the example above if you have this in the range A1:j:21 :

1 0,035181345

2 0,037730718

3 0,045967154

4 0,0300826

5 0,03953489

6 0,038750467

7 0,025493729

8 0,032122098

9 0,025689834

10 0,030592474

11 0,027533227

12 0,02765089

13 0,030514032

14 0,03184755

15 0,028945187

16 0,025493729

17 0,031925992

18 0,0300826

19 0,032122098

20 0,032292056



Excel return, this :

2 3 8 8 12 18 19 20

2 2 2 4 4 5 5
18

6 7 7 7 8 10 12
19

2 6 6 9 17 20 20 20

6 7 10 15 16 16 17 20

3 3 5 7 8 10 11
20

2 2 3 5 6 14 16
19




the problem is that in every rows there are repeat number :(

i don't want REPEAT number ......


can I solve it with VBA ????

"Jerry W. Lewis" ha scritto nel messaggio
...
The standard way to avoid repeated numbers in a selection of random
integers is to list all of the integers that might potentially be drawn
in one column, put =RAND() in the adjacent column, sort both by the RAND
column, and read off however many integers you wish in order.

You could program this in VBA.


hi......many thanks

the problem that i don't konw the vba code as well to do it :(

by !

This is substantively a repeat of the same posting you did on 11 April 2004

Subject: ATPVBAEN XLA [Number casual]

Jerry gave you several suggestions then. Explain why these will not work
and what is new about your question to avoid wasting time
rehashing/revisiting the same old information.

The fact that the Random tool in the Analysis toolpak does not generate
unique random numbers was pretty well established. There is no setting or
argument that changes that.

--
Regards,
Tom Ogilvy


"Aristotele64" wrote in message
...
Hi from Italy......so sorry for my bad english.....

As you Know in Excel there is a function called ATPVBAEN.XLA , that
generate
a casual combination :

here there is the excel example vba code :

Application.Run "ATPVBAEN.XLA!Random", ActiveSheet.Range("$P$2:$W$5000"),
8, 5000 _
, 7, , ActiveSheet.Range("$AI$1:$AJ$21")

and in the example above if you have this in the range A1:j:21 :

1 0,035181345

2 0,037730718

3 0,045967154

4 0,0300826

5 0,03953489

6 0,038750467

7 0,025493729

8 0,032122098

9 0,025689834

10 0,030592474

11 0,027533227

12 0,02765089

13 0,030514032

14 0,03184755

15 0,028945187

16 0,025493729

17 0,031925992

18 0,0300826

19 0,032122098

20 0,032292056



Excel return, this :

2 3 8 8 12 18 19
20

2 2 2 4 4 5 5
18

6 7 7 7 8 10 12
19

2 6 6 9 17 20 20
20

6 7 10 15 16 16 17 20

3 3 5 7 8 10 11
20

2 2 3 5 6 14 16
19




the problem is that in every rows there are repeat number :(

i don't want REPEAT number ......


can I solve it with VBA ????


TIA !

"Tom Ogilvy" ha scritto nel messaggio
...
This is substantively a repeat of the same posting you did on 11 April
2004

Subject: ATPVBAEN XLA [Number casual]

Jerry gave you several suggestions then. Explain why these will not work
and what is new about your question to avoid wasting time
rehashing/revisiting the same old information.

first I don't understand english ver well......
the reply that i have in my first post was not clear for me....

my number are all : "that might potentially be drawn"


The fact that the Random tool in the Analysis toolpak does not generate
unique random numbers was pretty well established. There is no setting or
argument that changes that.

ok....
i search BEYOND ATPVBAEN XLA a vba solution......if exist
by !

Your probabilities add up to approximately 0,63955267

the probabilities of a probability distribution should add up to 1,0

do you want to scale your probabilities on the basis of 0,63955267 or
what is it you actually want to do

Your input range is 21 rows, but you only show data for 20. Is it your
intent that 21 has a probability of

1 - 0,63955267

--
Regards,
Tom Ogilvy


"Aristotele64" wrote in message
...

"Jerry W. Lewis" ha scritto nel messaggio
...
The standard way to avoid repeated numbers in a selection of random
integers is to list all of the integers that might potentially be drawn
in one column, put =RAND() in the adjacent column, sort both by the RAND
column, and read off however many integers you wish in order.

You could program this in VBA.


hi......many thanks

the problem that i don't konw the vba code as well to do it :(

by !

news://msnews.microsoft.com/microsof...t.office.excel

--
Regards,
Tom Ogilvy


"Aristotele64" wrote in message
...

"Tom Ogilvy" ha scritto nel messaggio
...
This is substantively a repeat of the same posting you did on 11 April
2004

Subject: ATPVBAEN XLA [Number casual]

Jerry gave you several suggestions then. Explain why these will not
work
and what is new about your question to avoid wasting time
rehashing/revisiting the same old information.

first I don't understand english ver well......
the reply that i have in my first post was not clear for me....

my number are all : "that might potentially be drawn"


The fact that the Random tool in the Analysis toolpak does not generate
unique random numbers was pretty well established. There is no setting
or
argument that changes that.

ok....
i search BEYOND ATPVBAEN XLA a vba solution......if exist
by !

"Tom Ogilvy" ha scritto nel messaggio
...
Your probabilities add up to approximately 0,63955267

the probabilities of a probability distribution should add up to 1,0

do you want to scale your probabilities on the basis of 0,63955267 or
what is it you actually want to do

Your input range is 21 rows, but you only show data for 20. Is it your
intent that 21 has a probability of

1 - 0,63955267


i take only 20 rows for not waste space .....this an example correct :


1 0,02553976

2 0,03241585

3 0,036420605

4 0,036949535

5 0,042767764

6 0,033398148

7 0,028486656

8 0,030451253

9 0,02501083

10 0,040274238

11 0,030451253

12 0,03082906

13 0,025237515

14 0,028562217

15 0,028562217

16 0,022592865

17 0,041861027

18 0,039291939

19 0,042843326

20 0,029141522

21 0,02593268

22 0,031630011

23 0,03032028

24 0,034838853

25 0,022920298

26 0,026587545

27 0,027242411

28 0,034838853

29 0,028486656

30 0,032088417

31 0,025605247

32 0,028421169

"Tom Ogilvy" ha scritto nel messaggio
...
news://msnews.microsoft.com/microsof...t.office.excel

--
Regards,
Tom Ogilvy


i try
tk
by !

"Aristotele64" ha scritto nel messaggio
...

"Tom Ogilvy" ha scritto nel messaggio
...
news://msnews.microsoft.com/microsof...t.office.excel

--
Regards,
Tom Ogilvy

oopps italian newsgroup ?
no thanks.....we don't use excel as yankies

Hi from Italy......so sorry for my bad english.....

Guess your English is bad. I have no idea what you are trying to say.

--
Regards,
Tom Ogilvy

"Aristotele64" wrote in message
...

"Aristotele64" ha scritto nel messaggio
...

"Tom Ogilvy" ha scritto nel messaggio
...
news://msnews.microsoft.com/microsof...t.office.excel

--
Regards,
Tom Ogilvy

oopps italian newsgroup ?
no thanks.....we don't use excel as yankies

"Tom Ogilvy" ha scritto nel messaggio
...
Hi from Italy......so sorry for my bad english.....

Guess your English is bad. I have no idea what you are trying to say.


american are the best () in the word to use excel !
italian are the (<) in the word
by

No guarantees, but this appears to do something similar to what Jerry
described in the original thread.

Option Explicit
Sub Generate5000Setsof8()
Dim dist As Variant, distA As Variant
Dim dist1 As Variant
Dim sNum As Single
Dim ll As Long, i As Long, j As Long
Dim rnum(1 To 8) As Variant
Application.Calculation = xlManual
Randomize Time
dist = Range("AI1:AJ32")

Dim rng As Range
Set rng = Range("A2")
For ll = 1 To 5000
For i = 1 To 8
If i = 1 Then
dist = Range("AI1:AJ32")
dist1 = BuildCum(dist)
Else
If i = 2 Then
distA = BuildDist(dist)
Else
distA = BuildDist(distA)
End If
' Debug.Print i, TypeName(distA)
' Debug.Print LBound(distA, 1), UBound(distA, 1), LBound(distA, 2),
UBound(distA, 2)

dist1 = BuildCum(distA)
End If
' If i = 1 Then
' Range("AK1:AK32").Value = Application.Transpose(dist1)
' Else
' Range("Ai1").Offset(0, i * 3 - 2).Resize(UBound(distA, 1) -
LBound(distA, 1) _
' + 1, UBound(distA, 2) - LBound(distA, 2) + 1).Value = _
' distA
' Range("Ai1").Offset(0, i * 3).Resize(UBound(dist1, 1) - LBound(dist1, 1)
+ 1, 1) _
' .Value = Application.Transpose(dist1)
' End If
sNum = Rnd
For j = LBound(dist1) To UBound(dist1)
' Debug.Print j, snum, dist1(j)
If sNum <= dist1(j) Then
If i = 1 Then
rnum(i) = dist(j, LBound(dist, 2))
dist(j, LBound(dist, 2)) = 0
' Debug.Print "item: " & j
Else
rnum(i) = distA(j, LBound(distA, 2))
distA(j, LBound(distA, 2)) = 0
' Debug.Print "Item: " & j
End If
Exit For
End If
Next j
Next i
'For kl = 1 To 8
' Debug.Print rnum(kl);
'Next
Range("A2").Offset(ll - 1, 0).Resize(1, 8).Value = rnum
Next ll
Application.Calculation = xlAutomatic

End Sub
Function BuildDist(varr)
Dim distA() As Variant
Dim tot As Double
'Debug.Print "Builddist", LBound(varr, 1), UBound(varr, 1), _
' LBound(varr, 2), UBound(varr, 2)
Dim i As Long, j As Long, k As Long
ReDim distA(LBound(varr, 1) To UBound(varr, 1) - 1, _
LBound(varr, 2) To UBound(varr, 2))
i = LBound(varr, 1)
For j = i To UBound(varr, 1)
If varr(j, LBound(varr, 2)) < 0 Then
For k = LBound(varr, 2) To UBound(varr, 2)
distA(i, k) = varr(j, k)
Next
tot = tot + distA(i, UBound(varr, 2))
i = i + 1
End If
Next
For j = LBound(distA, 1) To UBound(distA, 1)
distA(j, UBound(distA, 2)) = _
(distA(j, UBound(distA, 2)) / tot)
Next
BuildDist = distA
End Function


Function BuildCum(varr) As Variant
Dim dist1()
Dim i As Long
ReDim dist1(LBound(varr, 1) To UBound(varr, 1))
For i = LBound(dist1) To UBound(dist1)
If i = LBound(dist1) Then
dist1(i) = varr(i, UBound(varr, 2))
Else
dist1(i) = dist1(i - 1) + varr(i, UBound(varr, 2))
End If
Next
'Debug.Print "Cum: " & dist1(UBound(dist1, 1))
BuildCum = dist1
End Function



--
Regards,
Tom Ogilvy

"Aristotele64" wrote in message
...

"Tom Ogilvy" ha scritto nel messaggio
...
Hi from Italy......so sorry for my bad english.....

Guess your English is bad. I have no idea what you are trying to say.


american are the best () in the word to use excel !
italian are the (<) in the word
by

And I bet you knocked that out in 30 seconds, Tom! <vbg

Regards,

Vasant.

"Tom Ogilvy" wrote in message
...
No guarantees, but this appears to do something similar to what Jerry
described in the original thread.

Option Explicit
Sub Generate5000Setsof8()
Dim dist As Variant, distA As Variant
Dim dist1 As Variant
Dim sNum As Single
Dim ll As Long, i As Long, j As Long
Dim rnum(1 To 8) As Variant
Application.Calculation = xlManual
Randomize Time
dist = Range("AI1:AJ32")

Dim rng As Range
Set rng = Range("A2")
For ll = 1 To 5000
For i = 1 To 8
If i = 1 Then
dist = Range("AI1:AJ32")
dist1 = BuildCum(dist)
Else
If i = 2 Then
distA = BuildDist(dist)
Else
distA = BuildDist(distA)
End If
' Debug.Print i, TypeName(distA)
' Debug.Print LBound(distA, 1), UBound(distA, 1), LBound(distA, 2),
UBound(distA, 2)

dist1 = BuildCum(distA)
End If
' If i = 1 Then
' Range("AK1:AK32").Value = Application.Transpose(dist1)
' Else
' Range("Ai1").Offset(0, i * 3 - 2).Resize(UBound(distA, 1) -
LBound(distA, 1) _
' + 1, UBound(distA, 2) - LBound(distA, 2) + 1).Value = _
' distA
' Range("Ai1").Offset(0, i * 3).Resize(UBound(dist1, 1) - LBound(dist1,
1)
+ 1, 1) _
' .Value = Application.Transpose(dist1)
' End If
sNum = Rnd
For j = LBound(dist1) To UBound(dist1)
' Debug.Print j, snum, dist1(j)
If sNum <= dist1(j) Then
If i = 1 Then
rnum(i) = dist(j, LBound(dist, 2))
dist(j, LBound(dist, 2)) = 0
' Debug.Print "item: " & j
Else
rnum(i) = distA(j, LBound(distA, 2))
distA(j, LBound(distA, 2)) = 0
' Debug.Print "Item: " & j
End If
Exit For
End If
Next j
Next i
'For kl = 1 To 8
' Debug.Print rnum(kl);
'Next
Range("A2").Offset(ll - 1, 0).Resize(1, 8).Value = rnum
Next ll
Application.Calculation = xlAutomatic

End Sub
Function BuildDist(varr)
Dim distA() As Variant
Dim tot As Double
'Debug.Print "Builddist", LBound(varr, 1), UBound(varr, 1), _
' LBound(varr, 2), UBound(varr, 2)
Dim i As Long, j As Long, k As Long
ReDim distA(LBound(varr, 1) To UBound(varr, 1) - 1, _
LBound(varr, 2) To UBound(varr, 2))
i = LBound(varr, 1)
For j = i To UBound(varr, 1)
If varr(j, LBound(varr, 2)) < 0 Then
For k = LBound(varr, 2) To UBound(varr, 2)
distA(i, k) = varr(j, k)
Next
tot = tot + distA(i, UBound(varr, 2))
i = i + 1
End If
Next
For j = LBound(distA, 1) To UBound(distA, 1)
distA(j, UBound(distA, 2)) = _
(distA(j, UBound(distA, 2)) / tot)
Next
BuildDist = distA
End Function


Function BuildCum(varr) As Variant
Dim dist1()
Dim i As Long
ReDim dist1(LBound(varr, 1) To UBound(varr, 1))
For i = LBound(dist1) To UBound(dist1)
If i = LBound(dist1) Then
dist1(i) = varr(i, UBound(varr, 2))
Else
dist1(i) = dist1(i - 1) + varr(i, UBound(varr, 2))
End If
Next
'Debug.Print "Cum: " & dist1(UBound(dist1, 1))
BuildCum = dist1
End Function



--
Regards,
Tom Ogilvy

"Aristotele64" wrote in message
...

"Tom Ogilvy" ha scritto nel messaggio
...
Hi from Italy......so sorry for my bad english.....

Guess your English is bad. I have no idea what you are trying to say.


american are the best () in the word to use excel !
italian are the (<) in the word
by

And probably enjoyed it a lot more than I enjoyed working on household
plubming today ;-)

Jerry

Vasant Nanavati wrote:

And I bet you knocked that out in 30 seconds, Tom! <vbg

Regards,

Vasant.

--

"Tom Ogilvy" ha scritto nel messaggio
...
No guarantees, but this appears to do something similar to what Jerry
described in the original thread.


All Working Fine !!!!
I don't have word for say : 1000 time Thanks !


God bless America !


* * * * * * ______________________________
* * * * * ______________________________
* * * * * * ______________________________
* * * * * ______________________________
* * * * * * ______________________________
* * * * * ______________________________
* * * * * * ______________________________
* * * * * ______________________________
* * * * * * ______________________________
_____________________________________________
_____________________________________________
_____________________________________________
_____________________________________________

hi again,
i was still happy for your solution........
and I have test it many time.......
don't call me rude if ask another 4 question :

1)

i've have tried to select only 14 of my 32 (based number)

and as you Newton Binomio say this :

n!
__________
K!(n-K)!

so if you take 14 number for "Setsof8" do you have :

Max 3.003 combination !

infact in results of vba code Generate5000Setsof8 we have some rows
duplicate
is possibile not generate it ?

2)

is possible have a "volatile" selection of based number, in sense :

one time i select 20 of my 32 based number
one time i select 15 of my 32 based number
one time i select 18 of my 32 based number


3)

I see many row in your code that begin with : '
are all comments ?
or is happened something in your copy and past ?


4)

how many time of your life have you spend for learn vba code as well ?????




I have also to grate you...and don't spend more time for
me.......****please*****......
if my question is hard to solve don't worry....i traspose all in access and
delete
duplicate record.


many thank for your attention.

I post the code that i have arranged, so you can understand more clear
(perhaps)
what i have tried to explain in my 2 question.



Application.ScreenUpdating = False

Dim riga As Range
Dim OutRange As Range
Set OutRange = [P2:W5000]


Range("AC1:AJ32").Select
Range("AJ32").Activate
Selection.ClearContents

Range("B1:B32,E1:E32,J1:J32").Select
Range("J1").Activate
Selection.Copy

Range("AD1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("AD1:AF32").Select
Range("AF1").Activate
Application.CutCopyMode = False
Selection.Sort Key1:=Range("AF1"), Order1:=xlDescending, Header:=xlGuess
_
, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("AD1:AF1").Select
Selection.AutoFilter
Selection.AutoFilter Field:=3, Criteria1:="FALSO"
Range("AD1:AF32").Select
Selection.ClearContents
Range("AE21").Select
Selection.FormulaR1C1 = "=SUM(R[-19]C:R[-1]C)"
Range("AG2").Select
ActiveCell.FormulaR1C1 = "=+RC[-2]/R21C31"
Range("AG2").Select
Selection.AutoFill Destination:=Range("AG2:AG15"), Type:=xlFillDefault
Range("AG2:AG15").Select
Range("AE21").Select
Selection.Cut Destination:=Range("AE1")
Range("AI2").Select
ActiveCell.FormulaR1C1 = "=+RC[-5]"
Range("AJ2").Select
ActiveCell.FormulaR1C1 = "=+RC[-3]"
Range("AI2:AJ2").Select
Selection.AutoFill Destination:=Range("AI2:AJ32"), Type:=xlFillDefault
Range("AI2:AJ15").Select

Application.Run "Generate5000Setsof8"

Range("P2:W5000").Select
For Each riga In Selection.Rows
riga.Sort Key1:=riga.Cells(1), Order1:=xlAscending, Header:=xlNo, _
Orientation:=xlLeftToRight
Next



End Sub




Sub Generate5000Setsof8()
Dim dist As Variant, distA As Variant
Dim dist1 As Variant
Dim sNum As Single
Dim ll As Long, i As Long, j As Long
Dim rnum(1 To 8) As Variant
Application.Calculation = xlManual
Randomize Time
dist = Range("AI1:AJ15")

Dim rng As Range
Set rng = Range("P2")
For ll = 1 To 5000
For i = 1 To 8
If i = 1 Then
dist = Range("AI1:AJ15")
dist1 = BuildCum(dist)
Else
If i = 2 Then
distA = BuildDist(dist)
Else
distA = BuildDist(distA)
End If
' Debug.Print i, TypeName(distA)
' Debug.Print LBound(distA, 1), UBound(distA, 1), LBound(distA, 2),
' UBound(distA, 2)

dist1 = BuildCum(distA)
End If
' If i = 1 Then
' Range("AK1:AK32").Value = Application.Transpose(dist1)
' Else
' Range("Ai1").Offset(0, i * 3 - 2).Resize(UBound(distA, 1) -
'LBound(distA, 1) _
' + 1, UBound(distA, 2) - LBound(distA, 2) + 1).Value = _
' distA
' Range("Ai1").Offset(0, i * 3).Resize(UBound(dist1, 1) - LBound(dist1, 1)
'+ 1, 1) _
' .Value = Application.Transpose(dist1)
' End If
sNum = Rnd
For j = LBound(dist1) To UBound(dist1)
' Debug.Print j, snum, dist1(j)
If sNum <= dist1(j) Then
If i = 1 Then
rnum(i) = dist(j, LBound(dist, 2))
dist(j, LBound(dist, 2)) = 0
' Debug.Print "item: " & j
Else
rnum(i) = distA(j, LBound(distA, 2))
distA(j, LBound(distA, 2)) = 0
' Debug.Print "Item: " & j
End If
Exit For
End If
Next j
Next i
'For kl = 1 To 8
' Debug.Print rnum(kl);
'Next
Range("p2").Offset(ll - 1, 0).Resize(1, 8).Value = rnum
Next ll
Application.Calculation = xlAutomatic

End Sub
Function BuildDist(varr)
Dim distA() As Variant
Dim tot As Double
'Debug.Print "Builddist", LBound(varr, 1), UBound(varr, 1), _
' LBound(varr, 2), UBound(varr, 2)
Dim i As Long, j As Long, k As Long
ReDim distA(LBound(varr, 1) To UBound(varr, 1) - 1, _
LBound(varr, 2) To UBound(varr, 2))
i = LBound(varr, 1)
For j = i To UBound(varr, 1)
If varr(j, LBound(varr, 2)) < 0 Then
For k = LBound(varr, 2) To UBound(varr, 2)
distA(i, k) = varr(j, k)
Next
tot = tot + distA(i, UBound(varr, 2))
i = i + 1
End If
Next
For j = LBound(distA, 1) To UBound(distA, 1)
distA(j, UBound(distA, 2)) = _
(distA(j, UBound(distA, 2)) / tot)
Next
BuildDist = distA
End Function


Function BuildCum(varr) As Variant
Dim dist1()
Dim i As Long
ReDim dist1(LBound(varr, 1) To UBound(varr, 1))
For i = LBound(dist1) To UBound(dist1)
If i = LBound(dist1) Then
dist1(i) = varr(i, UBound(varr, 2))
Else
dist1(i) = dist1(i - 1) + varr(i, UBound(varr, 2))
End If
Next
'Debug.Print "Cum: " & dist1(UBound(dist1, 1))
BuildCum = dist1


End Function

See comments inline

"Aristotele64" wrote in message
...
hi again,
i was still happy for your solution........
and I have test it many time.......
don't call me rude if ask another 4 question :

1)

i've have tried to select only 14 of my 32 (based number)

and as you Newton Binomio say this :

n!
__________
K!(n-K)!

so if you take 14 number for "Setsof8" do you have :

Max 3.003 combination !

yes =COMBIN(14,8) = 3003
Not sure what you are asking


infact in results of vba code Generate5000Setsof8 we have some rows
duplicate
is possibile not generate it ?

If you don't want duplicate rows, then one would have to store each
generated row and make a comparison against each with the current row, then
not write it if it is a duplicate. I would sort the data left to right
before writing it to facilitat the comparison (as your code does for the
entire data set).


If you want to generate all possible combinations of 8 items taken from 32,
then that would require different code
=COMBIN(32,8)
10518300

That would require 8 * 10518300 or around 84 Million cells - however, a
single sheet only has 16,8 million cells.


2)

is possible have a "volatile" selection of based number, in sense :

one time i select 20 of my 32 based number
one time i select 15 of my 32 based number
one time i select 18 of my 32 based number

Set it up so the 8 in the code is a variable in all cases.


3)

I see many row in your code that begin with : '
are all comments ?
or is happened something in your copy and past ?

Lines of code I used to test the results. I left them in there in case you
wanted to use them. I commented them out so they don't execute and write a
lot of extraneous information.



4)

how many time of your life have you spend for learn vba code as well ?????






I have also to grate you...and don't spend more time for
me.......****please*****......
if my question is hard to solve don't worry....i traspose all in access
and
delete
duplicate record.


many thank for your attention.

I post the code that i have arranged, so you can understand more clear
(perhaps)
what i have tried to explain in my 2 question.



Application.ScreenUpdating = False

Dim riga As Range
Dim OutRange As Range
Set OutRange = [P2:W5000]


Range("AC1:AJ32").Select
Range("AJ32").Activate
Selection.ClearContents

Range("B1:B32,E1:E32,J1:J32").Select
Range("J1").Activate
Selection.Copy

Range("AD1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("AD1:AF32").Select
Range("AF1").Activate
Application.CutCopyMode = False
Selection.Sort Key1:=Range("AF1"), Order1:=xlDescending,
Header:=xlGuess
_
, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("AD1:AF1").Select
Selection.AutoFilter
Selection.AutoFilter Field:=3, Criteria1:="FALSO"
Range("AD1:AF32").Select
Selection.ClearContents
Range("AE21").Select
Selection.FormulaR1C1 = "=SUM(R[-19]C:R[-1]C)"
Range("AG2").Select
ActiveCell.FormulaR1C1 = "=+RC[-2]/R21C31"
Range("AG2").Select
Selection.AutoFill Destination:=Range("AG2:AG15"), Type:=xlFillDefault
Range("AG2:AG15").Select
Range("AE21").Select
Selection.Cut Destination:=Range("AE1")
Range("AI2").Select
ActiveCell.FormulaR1C1 = "=+RC[-5]"
Range("AJ2").Select
ActiveCell.FormulaR1C1 = "=+RC[-3]"
Range("AI2:AJ2").Select
Selection.AutoFill Destination:=Range("AI2:AJ32"), Type:=xlFillDefault
Range("AI2:AJ15").Select

Application.Run "Generate5000Setsof8"

Range("P2:W5000").Select
For Each riga In Selection.Rows
riga.Sort Key1:=riga.Cells(1), Order1:=xlAscending, Header:=xlNo,
_
Orientation:=xlLeftToRight
Next



End Sub




Sub Generate5000Setsof8()
Dim dist As Variant, distA As Variant
Dim dist1 As Variant
Dim sNum As Single
Dim ll As Long, i As Long, j As Long
Dim rnum(1 To 8) As Variant
Application.Calculation = xlManual
Randomize Time
dist = Range("AI1:AJ15")

Dim rng As Range
Set rng = Range("P2")
For ll = 1 To 5000
For i = 1 To 8
If i = 1 Then
dist = Range("AI1:AJ15")
dist1 = BuildCum(dist)
Else
If i = 2 Then
distA = BuildDist(dist)
Else
distA = BuildDist(distA)
End If
' Debug.Print i, TypeName(distA)
' Debug.Print LBound(distA, 1), UBound(distA, 1), LBound(distA, 2),
' UBound(distA, 2)

dist1 = BuildCum(distA)
End If
' If i = 1 Then
' Range("AK1:AK32").Value = Application.Transpose(dist1)
' Else
' Range("Ai1").Offset(0, i * 3 - 2).Resize(UBound(distA, 1) -
'LBound(distA, 1) _
' + 1, UBound(distA, 2) - LBound(distA, 2) + 1).Value = _
' distA
' Range("Ai1").Offset(0, i * 3).Resize(UBound(dist1, 1) - LBound(dist1,
1)
'+ 1, 1) _
' .Value = Application.Transpose(dist1)
' End If
sNum = Rnd
For j = LBound(dist1) To UBound(dist1)
' Debug.Print j, snum, dist1(j)
If sNum <= dist1(j) Then
If i = 1 Then
rnum(i) = dist(j, LBound(dist, 2))
dist(j, LBound(dist, 2)) = 0
' Debug.Print "item: " & j
Else
rnum(i) = distA(j, LBound(distA, 2))
distA(j, LBound(distA, 2)) = 0
' Debug.Print "Item: " & j
End If
Exit For
End If
Next j
Next i
'For kl = 1 To 8
' Debug.Print rnum(kl);
'Next
Range("p2").Offset(ll - 1, 0).Resize(1, 8).Value = rnum
Next ll
Application.Calculation = xlAutomatic

End Sub
Function BuildDist(varr)
Dim distA() As Variant
Dim tot As Double
'Debug.Print "Builddist", LBound(varr, 1), UBound(varr, 1), _
' LBound(varr, 2), UBound(varr, 2)
Dim i As Long, j As Long, k As Long
ReDim distA(LBound(varr, 1) To UBound(varr, 1) - 1, _
LBound(varr, 2) To UBound(varr, 2))
i = LBound(varr, 1)
For j = i To UBound(varr, 1)
If varr(j, LBound(varr, 2)) < 0 Then
For k = LBound(varr, 2) To UBound(varr, 2)
distA(i, k) = varr(j, k)
Next
tot = tot + distA(i, UBound(varr, 2))
i = i + 1
End If
Next
For j = LBound(distA, 1) To UBound(distA, 1)
distA(j, UBound(distA, 2)) = _
(distA(j, UBound(distA, 2)) / tot)
Next
BuildDist = distA
End Function


Function BuildCum(varr) As Variant
Dim dist1()
Dim i As Long
ReDim dist1(LBound(varr, 1) To UBound(varr, 1))
For i = LBound(dist1) To UBound(dist1)
If i = LBound(dist1) Then
dist1(i) = varr(i, UBound(varr, 2))
Else
dist1(i) = dist1(i - 1) + varr(i, UBound(varr, 2))
End If
Next
'Debug.Print "Cum: " & dist1(UBound(dist1, 1))
BuildCum = dist1


End Function

One other thought. Combinations wouldn't seem to have much correlation to a
distribution. Combinations assumes equal chance between numbers I would
think.

This is starting to sound like some kind of lottery scheme.

If it is, it isn't worth my time.

--
Regards,
Tom Ogilvy

"Tom Ogilvy" wrote in message
...
See comments inline

"Aristotele64" wrote in message
...
hi again,
i was still happy for your solution........
and I have test it many time.......
don't call me rude if ask another 4 question :

1)

i've have tried to select only 14 of my 32 (based number)

and as you Newton Binomio say this :

n!
__________
K!(n-K)!

so if you take 14 number for "Setsof8" do you have :

Max 3.003 combination !

yes =COMBIN(14,8) = 3003
Not sure what you are asking


infact in results of vba code Generate5000Setsof8 we have some rows
duplicate
is possibile not generate it ?

If you don't want duplicate rows, then one would have to store each
generated row and make a comparison against each with the current row,
then
not write it if it is a duplicate. I would sort the data left to right
before writing it to facilitat the comparison (as your code does for the
entire data set).


If you want to generate all possible combinations of 8 items taken from
32,
then that would require different code
=COMBIN(32,8)
10518300

That would require 8 * 10518300 or around 84 Million cells - however, a
single sheet only has 16,8 million cells.


2)

is possible have a "volatile" selection of based number, in sense :

one time i select 20 of my 32 based number
one time i select 15 of my 32 based number
one time i select 18 of my 32 based number

Set it up so the 8 in the code is a variable in all cases.


3)

I see many row in your code that begin with : '
are all comments ?
or is happened something in your copy and past ?

Lines of code I used to test the results. I left them in there in case
you
wanted to use them. I commented them out so they don't execute and write
a
lot of extraneous information.



4)

how many time of your life have you spend for learn vba code as well
?????






I have also to grate you...and don't spend more time for
me.......****please*****......
if my question is hard to solve don't worry....i traspose all in access
and
delete
duplicate record.


many thank for your attention.

I post the code that i have arranged, so you can understand more clear
(perhaps)
what i have tried to explain in my 2 question.



Application.ScreenUpdating = False

Dim riga As Range
Dim OutRange As Range
Set OutRange = [P2:W5000]


Range("AC1:AJ32").Select
Range("AJ32").Activate
Selection.ClearContents

Range("B1:B32,E1:E32,J1:J32").Select
Range("J1").Activate
Selection.Copy

Range("AD1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("AD1:AF32").Select
Range("AF1").Activate
Application.CutCopyMode = False
Selection.Sort Key1:=Range("AF1"), Order1:=xlDescending,
Header:=xlGuess
_
, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom,
_
DataOption1:=xlSortNormal
Range("AD1:AF1").Select
Selection.AutoFilter
Selection.AutoFilter Field:=3, Criteria1:="FALSO"
Range("AD1:AF32").Select
Selection.ClearContents
Range("AE21").Select
Selection.FormulaR1C1 = "=SUM(R[-19]C:R[-1]C)"
Range("AG2").Select
ActiveCell.FormulaR1C1 = "=+RC[-2]/R21C31"
Range("AG2").Select
Selection.AutoFill Destination:=Range("AG2:AG15"),
Type:=xlFillDefault
Range("AG2:AG15").Select
Range("AE21").Select
Selection.Cut Destination:=Range("AE1")
Range("AI2").Select
ActiveCell.FormulaR1C1 = "=+RC[-5]"
Range("AJ2").Select
ActiveCell.FormulaR1C1 = "=+RC[-3]"
Range("AI2:AJ2").Select
Selection.AutoFill Destination:=Range("AI2:AJ32"),
Type:=xlFillDefault
Range("AI2:AJ15").Select

Application.Run "Generate5000Setsof8"

Range("P2:W5000").Select
For Each riga In Selection.Rows
riga.Sort Key1:=riga.Cells(1), Order1:=xlAscending,
Header:=xlNo,
_
Orientation:=xlLeftToRight
Next



End Sub




Sub Generate5000Setsof8()
Dim dist As Variant, distA As Variant
Dim dist1 As Variant
Dim sNum As Single
Dim ll As Long, i As Long, j As Long
Dim rnum(1 To 8) As Variant
Application.Calculation = xlManual
Randomize Time
dist = Range("AI1:AJ15")

Dim rng As Range
Set rng = Range("P2")
For ll = 1 To 5000
For i = 1 To 8
If i = 1 Then
dist = Range("AI1:AJ15")
dist1 = BuildCum(dist)
Else
If i = 2 Then
distA = BuildDist(dist)
Else
distA = BuildDist(distA)
End If
' Debug.Print i, TypeName(distA)
' Debug.Print LBound(distA, 1), UBound(distA, 1), LBound(distA, 2),
' UBound(distA, 2)

dist1 = BuildCum(distA)
End If
' If i = 1 Then
' Range("AK1:AK32").Value = Application.Transpose(dist1)
' Else
' Range("Ai1").Offset(0, i * 3 - 2).Resize(UBound(distA, 1) -
'LBound(distA, 1) _
' + 1, UBound(distA, 2) - LBound(distA, 2) + 1).Value = _
' distA
' Range("Ai1").Offset(0, i * 3).Resize(UBound(dist1, 1) -
LBound(dist1,
1)
'+ 1, 1) _
' .Value = Application.Transpose(dist1)
' End If
sNum = Rnd
For j = LBound(dist1) To UBound(dist1)
' Debug.Print j, snum, dist1(j)
If sNum <= dist1(j) Then
If i = 1 Then
rnum(i) = dist(j, LBound(dist, 2))
dist(j, LBound(dist, 2)) = 0
' Debug.Print "item: " & j
Else
rnum(i) = distA(j, LBound(distA, 2))
distA(j, LBound(distA, 2)) = 0
' Debug.Print "Item: " & j
End If
Exit For
End If
Next j
Next i
'For kl = 1 To 8
' Debug.Print rnum(kl);
'Next
Range("p2").Offset(ll - 1, 0).Resize(1, 8).Value = rnum
Next ll
Application.Calculation = xlAutomatic

End Sub
Function BuildDist(varr)
Dim distA() As Variant
Dim tot As Double
'Debug.Print "Builddist", LBound(varr, 1), UBound(varr, 1), _
' LBound(varr, 2), UBound(varr, 2)
Dim i As Long, j As Long, k As Long
ReDim distA(LBound(varr, 1) To UBound(varr, 1) - 1, _
LBound(varr, 2) To UBound(varr, 2))
i = LBound(varr, 1)
For j = i To UBound(varr, 1)
If varr(j, LBound(varr, 2)) < 0 Then
For k = LBound(varr, 2) To UBound(varr, 2)
distA(i, k) = varr(j, k)
Next
tot = tot + distA(i, UBound(varr, 2))
i = i + 1
End If
Next
For j = LBound(distA, 1) To UBound(distA, 1)
distA(j, UBound(distA, 2)) = _
(distA(j, UBound(distA, 2)) / tot)
Next
BuildDist = distA
End Function


Function BuildCum(varr) As Variant
Dim dist1()
Dim i As Long
ReDim dist1(LBound(varr, 1) To UBound(varr, 1))
For i = LBound(dist1) To UBound(dist1)
If i = LBound(dist1) Then
dist1(i) = varr(i, UBound(varr, 2))
Else
dist1(i) = dist1(i - 1) + varr(i, UBound(varr, 2))
End If
Next
'Debug.Print "Cum: " & dist1(UBound(dist1, 1))
BuildCum = dist1


End Function

yes =COMBIN(14,8) = 3003
Not sure what you are asking

Nothing , an example to explain why I search to delete duplicate........



infact in results of vba code Generate5000Setsof8 we have some rows
duplicate
is possibile not generate it ?

If you don't want duplicate rows, then one would have to store each
generated row and make a comparison against each with the current row,
then
not write it if it is a duplicate. I would sort the data left to right
before writing it to facilitat the comparison (as your code does for the
entire data set).

I always use this :) ......i was thinking that wasn't the best but a my
primitive mode
sometimes the most easy is the best :)



If you want to generate all possible combinations of 8 items taken from
32,
then that would require different code
=COMBIN(32,8)
10518300

That would require 8 * 10518300 or around 84 Million cells - however, a
single sheet only has 16,8 million cells.

yes 10.518.300 record ! I have do it with Access : 368 mega of space !


is possible have a "volatile" selection of based number, in sense :

one time i select 20 of my 32 based number
one time i select 15 of my 32 based number
one time i select 18 of my 32 based number

Set it up so the 8 in the code is a variable in all cases.

ok...i wasn't sure of this........tk


Lines of code I used to test the results. I left them in there in case
you
wanted to use them. I commented them out so they don't execute and write
a
lot of extraneous information.

i have immage this......
i think that can i study it for many month :)



Still many thanks from italy .

You are welcome !

"Tom Ogilvy" ha scritto nel messaggio
...
One other thought. Combinations wouldn't seem to have much correlation to
a
distribution. Combinations assumes equal chance between numbers I would
think.

This is starting to sound like some kind of lottery scheme.


Not a lottery but a similar .
It's play called "Totogol" connect at italian football league .
In this game , you have to indicate the 8 match on 32 , where was
terminated with the max number of goal.


If it is, it isn't worth my time.

I'm sorry for this , but I think that I good mode to learn something
is playing with it.....

by !