Losowanie zestawu niepowtarzalnych liczb z zadanego zakresu   strona główna:
A po co ten Excel ;-)
 
    Temat nieszczególnie nowy jednak może nowe/inne podejście do sprawy. :-)  
Zadaniem jest wylosowanie do zdanego zakresu liczb losowych niepowtarzalnych. Napiszę więc funkcję użytkownika którą będzie można wprowadzić  
tablicowo do zakresu do którego wylosujemy zestaw liczb.  
 
  A B C D E  
1 6 19 21 14 5  
2 15 18 11 24 12  
3 4 25 10 22 3  
4 23 8 9 2 17  
5 7 20 13 16 1  
 
Przykład powyżej to wyniki jakie zwraca funkcja =LiczbyLosowo(1;25) zatwierdzona tablicowo na zakresie A1:E5  
Jak napisać taką funkcję? Sposobów jest naprawdę sporo. Te najbardziej proste losują zadaną ilość razy liczbę z zadanego zakresu i próbują  
zapisać wynik do kolekcji. A że w kolekcji nie może być dwóch takich samych kluczy to po pewnej liczbie prób stworzymy nasz "zestaw".  
    Zastanówmy się jednak nad tą "pewną liczbą prób". Losujemy zestaw 100 liczb całkowitych od 1 do 100. Wylosowaliśmy już 99 :-) i znów   
losujemy… zakres 1 do 100 … i tą już mamy -> nastepny raz od 1 do 100… tą też mamy, … itd…. :-)  
W końcu się uda ale prawdopodobieństwo wylosowania tej brakującej to zaledwie 1%. Przy dużym zakresie wylosowanie tych ostatnich liczb  
może trwać naprawdę bardzo długo (malej prawdopodobieństwo wylosowania brakującej co wiąze się z ciągłym powtarzaniem losowań)  
    Ja podejdę do tematu trochu inaczej :-)  
 
Function LiczbyLosowo(dMin As Double, dMax As Double, Optional dStep As Double = 1) As Variant  
    Dim r As Long, c As Integer  
    Dim iR As Long, iC As Long, iL As Long  
    Dim tbl() As Double  
    Dim colLiczby As VBA.Collection, iCol As Double  
      
    With Application.Caller  
        r = .Rows.Count  
        c = .Columns.Count  
        If (r * c) > (dMax - dMin + 1) / dStep Then Exit Function  
    End With  
    ReDim tbl(1 To r, 1 To c)  
      
    Set colLiczby = New VBA.Collection  
    With colLiczby  
        For iCol = dMin To dMax Step dStep  
            .Add iCol, CStr(iCol)  
        Next  
          
        Randomize  
        For iR = 1 To r  
            For iC = 1 To c  
                iL = Int((.Count * Rnd) + 1)  
                tbl(iR, iC) = .Item(iL): .Remove (iL)  
            Next  
        Next  
    End With  
    Set colLiczby = Nothing  
      
    LiczbyLosowo = tbl  
                    
End Function  
 
Fragmentami:  
 
    With Application.Caller  
        r = .Rows.Count  
        c = .Columns.Count  
        If (r * c) > (dMax - dMin + 1) / dStep Then Exit Function  
    End With  
    ReDim tbl(1 To r, 1 To c)  
 
Ten fragment okresli ile liczb ma być wylosowana i jak ma wyglądać zakres do którego zwracamy wyniki. Jak? :-) Jak formułę wprowadzimy  
do zakresu A1:C5 to wynikiem funkcji ma być tablica o 5wierszach i 3kolumnach a jej zawartość to 15liczb z jakiegoś zkresu :-)  
Posługując się Application.Caller wymiary wynikowej tablicy uzależniam od ielkości zakresu do którego wprowadzona jest formuła.  
     Oczywiście jeżeli przeznaczony na wyniki funkcji zakres jest wiekszy niż ilość liczb możliwych do wylosowania to zabawa jest skazana na   
niepowodzenie. Jeżeli jednak ta granica nie została przekroczona tworzę odpowiedniej wielkości tablicę.  
 
    Set colLiczby = New VBA.Collection  
    With colLiczby  
        For iCol = dMin To dMax Step dStep  
            .Add iCol, CStr(iCol)  
        Next  
 
Tu zaczyna się mój pomysł na losowanie unikatów.. Do kolekcji nie zapisuję unikatów a wszystkie możliwe wyniki.  
 
        Randomize  
        For iR = 1 To r  
            For iC = 1 To c  
                iL = Int((.Count * Rnd) + 1)  
                tbl(iR, iC) = .Item(iL): .Remove (iL)  
            Next  
        Next  
 
 - Losuję liczbę z zakresu od 1 do ilości elementów kolekcji (iL)  
 - element iL kolekcji zapisuję do tablicy wyników  
 - usuwam element iL z kolekcji  
Całość powtarzam w podwójnej pętli wypełniając kolejne elementy tablicy wyników  
    Gdzie przewaga takiego rozwiązania?? Taki sposób nie wymaga powtarzań losowań bo za każdym razem losujemy inną/niepowtarzalną  
liczbę. Po jej wylosowaniu usuwam ją z kolekkcji z której losuję i następne losowanie odbywa się na kolekcji ale już bez tego elementu :-)  
Ta funkcja wykonuje się migiem :-)  
    Wykorzystuje Application.Callse więc funkcja jest przeznaczona jedynie do zastosowań Arkuszowych w VBA trzeba zrezygnować z tego  
rozwiązania a wielkość tablicy wyników podać w arguemtach funkcji. Hej :-)