Excel Forum - Porady, Pomoc,  Excel Help, Excel FAQ Strona Główna
 FAQ  RegulaminRegulamin  Szukaj   Użytkownicy   Grupy   Rejestracja   Profil   Twoje wiadomości   Zaloguj 


Poprzedni temat «» Następny temat
ID tematu: 19484 Skopiuj do schowka losowanie bez pow. - przerobienie makra
Autor Wiadomość
Ja_Jakub 
Fan Excela


Pomógł: 22 razy
Posty: 76
Wysłany: 21-12-2010, 10:01   losowanie bez pow. - przerobienie makra

Witam,

jedną z części projektu jest taki oto kod:

Kod:
Range("d2:d11").ClearContents
Range("e1").Value = 0

For Each liczby In Range(Cells(2, 4), Cells(9, 4))
ost = Range("d10000").End(xlUp).Row + 1
b = False

Do While b = False
los = Int(8 * Rnd() + 1)
istnieje = False
    For Each kom In Range(Cells(2, 4), Cells(9, 4))
    If kom.Value = los Then
    istnieje = True
    End If
    Next kom

If istnieje = False Then
Cells(ost, 4) = los
b = True
End If
Loop
Next liczby


Makro ma za zadanie w zakresie d2:d10 wylosować 1 z 8 ale tak by się wartości nie powtarzały. Dzieki takiemu losowaniu układ ich ułożenia jest zawsze inny.
Makro działa bez problemu, tylko moje pytanie jest takie: Czy da się to jakoś tak przerobić by nie trzeba było używać komórek do wypełania wartości i sprawdzania czy taka wartość jużbyła wylosowana? A może da się to zrobić jakoś na class -ach? Nie bardzo mogę się połapać jak funkcjonują class module dlatego nie wiem jak to przerobić.
ID posta: 103176 Skopiuj do schowka
 
 
hudibyk 
Excel Expert



Pomógł: 361 razy
Posty: 1111
Wysłany: 21-12-2010, 10:24   

Do przechowywania liczb użyj tablicy. W tablicy wyszukuj za pomocą Application.Match. A jak tego użyć to tutaj masz pokazane, zwłaszcza w poście Tajana
_________________
Hudibyk
ID posta: 103180 Skopiuj do schowka
 
 
master_mix 
Excel Expert



Pomógł: 1140 razy
Posty: 2096
Wysłany: 21-12-2010, 10:26   

porzejżyj TEN wątek
_________________
>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Podejmę współpracę (pracę) w zakresie tworzenia aplikacji arkusza kalkulacyjnego z wykorzystaniem VBA. Programowanie VB.NET, ASP.NET, WPF. Technologie LINQ, Entity Framework. Aplikacje klienckie dla baz danych SQL Server, Oracle, MySQL
Wrocław i okolice …lub zdalnie.
>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
ID posta: 103181 Skopiuj do schowka
 
 
Wormsek 



Zaproszone osoby: 2
Pomógł: 907 razy
Posty: 5225
Wysłany: 21-12-2010, 11:13   

Nie patrzyłem na linki, ale możesz użyć kolekcji, która pozwoli ci wrzycić tylko unikatowe liczby.
Zobacz na przykład TUTAJ
_________________
Pozdro
Worm

FAQ - Najczęściej zadawane pytania.
JAK KORZYSTAĆ Z SZUKAJKI
Słownik funkcji

Znajdź nas na Facebook'u

A może fajny dodatek do excela?
ID posta: 103188 Skopiuj do schowka
 
 
tkuchta1 
Excel Expert



Pomógł: 1749 razy
Posty: 2888
Wysłany: 21-12-2010, 11:31   

Ja sobie wykombinowałem że do tablicy tblLos o określonej, różnicą między granicznymi wartościami, ilości elementów wylosuję niepowtarzalne liczby rzeczywiste z zakresu 0-1 Rnd() a później to tblWyniki() zwrócę Pozycję Application.Rank wylosowanych elementów w tblLos. Okazuje się że Application.Rank buntuje się jezeli w poz. lista wstawię tblLos (nawet dwu wymiarową).
Poszukując info nt. problemów z f. Rank trafiłem na udfRank więc się w nią nie bawiłem
Kod:
Function SortujLosowo(lngOd As Long, lngDo As Long) As Variant
    Dim lngIle As Long
    Dim tblLos() As Variant, iD As Long
    Dim colUni As VBA.Collection, colItem As Variant
    Dim tblWyniki() As Long
   
    Set colUni = New VBA.Collection
   
    lngIle = lngDo - lngOd + 1
    ReDim tblLos(1 To lngIle)
    ReDim tblWyniki(1 To lngIle, 1 To 1)
   
    Randomize
    On Error Resume Next
    For iD = 1 To lngIle
        Do
            colItem = Rnd()
            colUni.Add colItem, CStr(colItem)
            If Err.Number <> 0 Then
                Err.Clear
            Else
                Exit Do
            End If
        Loop
        tblLos(iD) = colItem
    Next
    On Error GoTo 0
   
    For iD = 1 To lngIle
        tblWyniki(iD, 1) = lngOd + udfRank(tblLos(iD), tblLos, True) - 1
    Next
    SortujLosowo = tblWyniki
End Function

Function udfRank(Wert, Wertereihe, Optional aufsteigend = True)
    'http://www.herber.de/forum/archiv/1124to1128/t1127582.htm
    Dim dblW As Double, lngZ As Long, lngE As Long
   
    For lngZ = LBound(Wertereihe) To UBound(Wertereihe)
        If aufsteigend Then
            If Wert >= Wertereihe(lngZ) Then lngE = lngE + 1
        Else
            If Wert < Wertereihe(lngZ) Then lngE = lngE + 1
        End If
    Next
    udfRank = lngE
End Function

i przykładowa procedura
Kod:
Sub Start()
    Dim xlWks As Excel.Worksheet
   
    Set xlWks = ThisWorkbook.Worksheets("Arkusz1")
    With xlWks.Range("D2:D9")
        .Value = SortujLosowo(1, .Cells.Count)
    End With
    Set xlWks = Nothing
End Sub
_________________
Tomek



Moja Stronka
APoCoTenExcel
Ostatnia aktualizacja: 2015-09-04
ID posta: 103191 Skopiuj do schowka
 
 
Ja_Jakub 
Fan Excela


Pomógł: 22 razy
Posty: 76
Wysłany: 22-12-2010, 10:00   

Dzieki wszystki za odpowiedź, jednak nie do końca znalazłem rozwiązanie.

Nie chodziło mi o to byście podali mi jak stworzyć własną funckę losującą lub jak inaczej losowac.

Ponieważ wyniki losowania są przypisywane do mojego userform a następnie do konkretnych commandbutton, to chciałby losowanie (a co za tym idzie potem sprawdzanie) zrobić tak jak by w pamięci excela/komputera bez wpisywania wartości commandbutton do konkretnych komórek.

W załączniku moja gra (cos w rodzaju puzzli) w której wykorzystuje losowanie.

puzzle liczbowe.rar
Pobierz Plik ściągnięto 142 raz(y) 27.62 KB

ID posta: 103273 Skopiuj do schowka
 
 
tkuchta1 
Excel Expert



Pomógł: 1749 razy
Posty: 2888
Wysłany: 22-12-2010, 14:54   

Zobacz załącznik :-)

Ps: Wiem że trochu jeszcze brakuje ale nie starczyło mi dziś czasu.
Brakujące rzeczy i opis całości w najbliższym czasie na mojeje stronie

xlPuzle.zip
Pobierz Plik ściągnięto 150 raz(y) 25.3 KB

_________________
Tomek



Moja Stronka
APoCoTenExcel
Ostatnia aktualizacja: 2015-09-04
ID posta: 103299 Skopiuj do schowka
 
 
Ja_Jakub 
Fan Excela


Pomógł: 22 razy
Posty: 76
Wysłany: 23-12-2010, 13:14   

O to chodziło :) Mam nadzieję, że na podstawie Twojego rozwiązania uda i się lepiej zrozuimeć klasy.... bo jak narazie ciężko to idzie.

Bo docelowo chciałbym zrobić własne sudoku w vba a myślę, że klasy to ułatwią.

pozdr i dzieki za rozwiązanie.

edit:
zauważyłem jedna rzecz. Przy większej (chyba > niz 4 )liczbie wierszy nie dziła prawidłowo. to znaczy nie da się zamienic pusty z liczbowy jak liczbowy jest nad pustym
ID posta: 103372 Skopiuj do schowka
 
 
Wyświetl posty z ostatnich:   
Odpowiedz do tematu
Nie możesz pisać nowych tematów
Nie możesz odpowiadać w tematach
Nie możesz zmieniać swoich postów
Nie możesz usuwać swoich postów
Nie możesz głosować w ankietach
Nie możesz załączać plików na tym forum
Możesz ściągać załączniki na tym forum
Dodaj temat do Ulubionych
Wersja do druku

Skocz do:  

Powered by phpBB modified by Przemo © 2003 phpBB Group
Theme xandgreen created by spleen& Programosy modified v0.3 by warna
Opieka techniczna www.marketingNET.pl

Archiwum