Home |
Search |
Today's Posts |
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 ! |
#2
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 ???? |
#3
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]() "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 ! |
#4
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 ! |
#5
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]() "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 ! |
#6
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 ! |
#7
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 ! |
#8
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]() "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 |
#9
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]() "Tom Ogilvy" ha scritto nel messaggio ... news://msnews.microsoft.com/microsof...t.office.excel -- Regards, Tom Ogilvy i try tk by ! |
#10
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]() "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 |
#11
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 |
#12
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]() "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 |
#13
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 |
#14
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 |
#15
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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. |
#16
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
--
"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 ! * * * * * * ______________________________ * * * * * ______________________________ * * * * * * ______________________________ * * * * * ______________________________ * * * * * * ______________________________ * * * * * ______________________________ * * * * * * ______________________________ * * * * * ______________________________ * * * * * * ______________________________ _____________________________________________ _____________________________________________ _____________________________________________ _____________________________________________ |
#17
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 |
#18
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 |
#19
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 |
#20
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]() 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 ! |
#21
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]() "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 ! |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
Generate random sequence based on probability | Excel Discussion (Misc queries) | |||
Probability of random numbers | Excel Discussion (Misc queries) | |||
Column picked randomly with probability relative to number of entr | Excel Worksheet Functions | |||
How do I find random number in list of random alpha? (Position is. | Excel Discussion (Misc queries) | |||
Selecting at random with weighted probability | Excel Worksheet Functions |