Avatar billede line240200 Nybegynder
05. juni 2011 - 14:13 Der er 21 kommentarer og
1 løsning

Forhindre at 2 tal er ens

Har fundet denne kode, men kan man ikke forhindre at der vælges 2 ens tal?

Sub Knap1_Klik()
Dim myInt As Integer
    myInt = InputBox("Hvor mange stikprøver skal du tage?", "Hvor mange?", 1)
    Dim counter As Integer
    For counter = 1 To myInt
    Randomize
    Dim myRange As Range
    Dim rTal As Integer
    Dim LuckyNumber As Integer
    Dim LuckyMan As String
    Sheets(1).Cells(1, 1).Select
    Set myRange = Selection.CurrentRegion
    rTal = myRange.Rows.Count
    LuckyNumber = Int((rTal - 1) * Rnd + 2)
    LuckyMan = Cells(LuckyNumber, 1)
    Cells(counter, 5) = LuckyMan
    Next

   
   
End Sub
Avatar billede Ialocin Novice
08. juni 2011 - 14:32 #1
Hej Line240200

Er det rigtigt forstået, at man taster det antal tal ind i input dialogen, som man ønsker udtrukket ?

Og hvor skal tallene "parkeres" efter trækningen ?

Med venlig hilsen, Nicolai
Avatar billede Ialocin Novice
08. juni 2011 - 15:19 #2
Hej Line240200


Kan ikke få din kodestump til at virke ?
Jeg har derfor rettet den lidt til, udfra hvad jeg tror du vil med den.


I eksemplet nedenfor har jeg oprettet en knap "cmdTrækTal", hvorunder koden ligger ... De trukne tal bliver "parkeret" i kolonne A, startende i celle 1 og slutter i det ønskede antal tal.
Der bliver også tjekket for allerede udtrukne tal.



Private Sub cmdTrækTal_Click()

Dim myRange As Range
Dim LuckyNumber As Integer
Dim myInt As Integer
Dim counter As Integer


    'spø´r om hvor mange tal der skal trækkes
    myInt = InputBox("Hvor mange stikprøver skal du tage?", "Hvor mange?", 1)
   
   
        'bliv ved indtil det ønskede antal tal er udtrukket
        For counter = 1 To myInt
       
        'tilfældighedsgenerator
        Randomize
       
                           
                'vælg området til de udtrukne tal
                'start i celle "A1" og slut i det ønskede antal .. i kolonne A
                Range("A1", "A" & myInt).Select
               
               
                'set myRange = det ovenfor valgte område
                Set myRange = Selection.CurrentRegion
               
                                     
                'træk lykkenummeret
                LuckyNumber = Int((myInt * Rnd) + 1)
               
       
       
                        'Tjek om tallet allerede er udtrukket
line1:                  For Each c In myRange.Cells
       
                            'hvis tallet allerede er udtrukket
                            If c.Value = LuckyNumber Then
                           
                                'træk et nyt tal
                                Randomize
                                LuckyNumber = Int((myInt * Rnd) + 1)
                           
                                'gå til line1 og tjek igen
                                GoTo line1
                           
                           
                            'hvis tallet ikke allerede er udtrukket
                            Else
                           
                                'fyld cellerne i det valgte område med de udtrukne lykkenummer
                                myRange.Cells(counter, 1).Value = LuckyNumber
                                           
                                           
                            End If
                           
                           
                        'tjek næste celle
                        Next
                               
                               
        'fyld i næste celle
        Next
   
   

End Sub



---------


Med venlig hilsen, Nicolai
Avatar billede line240200 Nybegynder
08. juni 2011 - 19:22 #3
Hej Nicolai
Forstår ikke at du ikke kan få min "stump" til at køre, her kører det fint.
Til gengæld kan jeg ikke få din version til at køre.
Jeg har Excel 2010, ved ikke om det gør en forskel.
Jeg er ret grøn hvad angår VBA, men jeg opretter en knap og forsøger så at tilføje den kode du har skrevet men uden held.
Avatar billede Ialocin Novice
08. juni 2011 - 22:43 #4
Hej Line240200

Jeg er ikke klar over om der VBA mæssigt er forskel på Excel 2003 og Excel 2010 ???

Hvis du har oprettet en knap på dit worksheet, så skal du blot dobbeltklikke på den, hvorefter du burde stå i knappens klik hændelse i VBA editoren.
Kopier så min kode stump ind ... uden den første og sidste linie


Hvilke fejlmeddelelser får du ved min kodestump ??
Hvad gør din kodestump, når du aktiverer den ??

Med venlig hilsen, Nicolai
Avatar billede line240200 Nybegynder
09. juni 2011 - 12:28 #5
Nu har jeg fået det til at køre, men meningen var at man eksempelvis i kolonne A indtaster en række tal og at det er fra den talrække der udtrækkes men det kunne du jo ikke vide.
Talrækken skal kunne forøges med tiden.
Avatar billede Ialocin Novice
09. juni 2011 - 12:44 #6
Hej Line240200

Super ;o)
Jeg kigger lige på det ...


Og bare så forståelsen er i orden:

- Du skal kunne taste de tal ind i kolonne A, som du ønsker skal kunne trækkes ??

- Hvor skal de udtrukne tal parkeres/arkiveres/vises ??


Med venlig hilsen, Nicolai
Avatar billede line240200 Nybegynder
09. juni 2011 - 14:09 #7
Hej Nicolai
Præcis placeringen er sådan set ligemeget, det tror jeg godt jeg selv kan ændre, men feks. i kolonne C og nedefter.Takker for din hjælp
Avatar billede line240200 Nybegynder
09. juni 2011 - 14:10 #8
Men ja, ellers det rigtig forstået.
Avatar billede Ialocin Novice
09. juni 2011 - 15:08 #9
Hej Line240200

Super, jeg vender tilbage i aften :o)


Mvh Nicolai
Avatar billede Ialocin Novice
10. juni 2011 - 12:08 #10
Hej Line240200

Bedre sent end aldrig ;o)

Her er lidt kode, som ikke burde finde identiske værdier.


OBS:
Som koden er p.t. tager den IKKE højde for følgende ...

- Hvis det ønskede antal stikprøver er mindre end eller lig 0.
- Hvis det ønskede antal stikprøver er større end prøver til rådighed.
- Hvis det ønskede antal stikprøver indtastes som alt andet end et heltal.
- Hvis det ønskede antal stikprøver er er blank.
- Hvis der tastes på Cancel knappen på input boksen.


Kopier følgende ind i din knap hændelse:



Dim AntalØnskedeTal As Integer  'antal værdier der ønskes udtrukket
Dim udtrukneTal As Range        'område til de udtrukne værdier
Dim counter As Integer          'tæller til trækningen
Dim MuligeTal As Range          'område hvorfra der trækkes
Dim rTal As Integer            'antallet af værdier der kan trækkes
Dim rNummer As Integer          'række nummer
Dim rVærdi As String            'række værdi

       
       
        'vælg celle "A1"
        Sheets(2).Cells(1, 1).Select
       
       
        'set MuligeTal = fra celle "A1" og nedad
        Set MuligeTal = Selection.CurrentRegion
       
       
        'tæl hvor mange tal der kan trækkes
        rTal = MuligeTal.Rows.Count
   
           
        'Spø´r brugeren om hvor mange tak der øsnkes udtrukket
        AntalØnskedeTal = InputBox("Hvor mange stikprøver skal du tage?", "Hvor mange?", 1)
       
       
        'set udtrukneTal = kolonne C fra celle 1 til det ønskede antal udtrukne tal
        Set udtrukneTal = Range("C1", "C" & AntalØnskedeTal)
   
   
   
     
    'gør klar til trækning
    For counter = 1 To AntalØnskedeTal
   
   
                'tilfældighedsgenerator
                Randomize
               
                           
               
                'træk et række nummer !!!
line1:                              rNummer = Int((rTal - 1 + 1) * Rnd + 1)
               
                 
                'slå skærmopdatering fra
                Application.ScreenUpdating = False
               
               
               
                        'løb gennem cellerne og tjek for identiske værdier
                        For Each c In udtrukneTal.Cells
           
                               
                                'hvis celle værdien er = den udtrukne værdi
                                If c.Value = Cells(rNummer, 1).Value Then
           
                                        'gå til line1 og træk et nyt række nummer (med tilhørende værdi!)
                                        GoTo line1
           
                                End If
                               
                               
                        'tjek næste celle for identisk værdi
                        Next
           
           
           
           
               
                'rVærdi = celle værdien i kolonne A hvor værdien er lig med den udtrukne værdi
                rVærdi = Cells(rNummer, 1).Value
       
                'Tildel rVærdi fortløbende i kolonne C
                Cells(counter, 3) = rVærdi
       
               
               
                'slå skærmopdatering til
                Application.ScreenUpdating = True
   
   
    'gør klar til næste trækning
    Next


-------



Med venlig hilsen, Nicolai
Avatar billede Ialocin Novice
10. juni 2011 - 13:27 #11
Hej Line240200

Hermed en tilrettet kode, som bør ta´ højde for diverse "forkerte" input i inputboksen.

Kopier følgende ind i din knap hændelse:


Dim i As Variant                'variabel til input fra dialogen
Dim AntalØnskedeTal As Integer  'antal værdier der ønskes udtrukket
Dim udtrukneTal As Range        'område til de udtrukne værdier
Dim counter As Integer          'tæller til trækningen
Dim MuligeTal As Range          'område hvorfra der trækkes
Dim rTal As Integer            'antallet af værdier der kan trækkes
Dim rNummer As Integer          'række nummer
Dim rVærdi As String            'række værdi

       
       
        'vælg celle "A1"
        Sheets(2).Cells(1, 1).Select
       
       
        'set MuligeTal = fra celle "A1" og nedad
        Set MuligeTal = Selection.CurrentRegion
       
       
        'tæl hvor mange tal der kan trækkes
        rTal = MuligeTal.Rows.Count
   
           
        'Spø´r brugeren om hvor mange tak der øsnkes udtrukket
line1:  i = InputBox("Hvor mange stikprøver skal du tage?", "Hvor mange?", 1)
       
       
           
'tjek svaret fra inputboksen
Select Case i

            'svaret er blankt
            Case ""
           
                    'Der sker intet når bruger lader antallet være tomt,
                    'klikker på CANCEL eller lukker inputboksen
                   
                   
                   
            'svaret ligger inden for det mulige antal
            Case 1 To rTal
           
           
                    'konverter input svaret fra en variant til en integer
                    AntalØnskedeTal = Int(i)
                   
                   
                   
                    'set udtrukneTal = kolonne C fra celle 1 til det ønskede antal udtrukne tal
                    Set udtrukneTal = Range("C1", "C" & AntalØnskedeTal)
           
           
           
           
                    'gør klar til trækning
                    For counter = 1 To AntalØnskedeTal
               
               
                                'tilfældighedsgenerator
                                Randomize
               
               
               
                                'træk et række nummer !!!
line2:                          rNummer = Int((rTal - 1 + 1) * Rnd + 1)
               
               
                                'slå skærmopdatering fra
                                Application.ScreenUpdating = False
               
               
               
                                        'løb gennem cellerne og tjek for identiske værdier
                                        For Each c In udtrukneTal.Cells
               
               
                                                'hvis celle værdien er = den udtrukne værdi
                                                If c.Value = Cells(rNummer, 1).Value Then
               
                                                        'gå til line2 og træk et nyt række nummer (med tilhørende værdi!)
                                                        GoTo line2
               
                                                End If
               
               
                                        'tjek næste celle for identisk værdi
                                        Next
               
               
               
               
               
                                'rVærdi = celle værdien i kolonne A hvor værdien er lig med den udtrukne værdi
                                rVærdi = Cells(rNummer, 1).Value
               
                                'Tildel rVærdi fortløbende i kolonne C
                                Cells(counter, 3) = rVærdi
               
               
               
                                'slå skærmopdatering til
                                Application.ScreenUpdating = True
               
               
                    'gør klar til næste trækning
                    Next
           
           
            'svaret er alt andet end ovenstående tjek
            Case Else
           
                    MsgBox "Der er ikke valgt et korrekt antal stikprøver!", vbOKOnly & vbInformation
           
                   
                    'åbn inputboksen igen
                    GoTo line1
                           
                   

End Select


-------

Med venlig hilsen, Nicolai
Avatar billede line240200 Nybegynder
10. juni 2011 - 19:44 #12
Hej Nicolai
Der bliver altså nogle gange trukket det samme tal flere gange, desværre.
Avatar billede line240200 Nybegynder
10. juni 2011 - 19:52 #13
Sorry..det var vist en fejl fra min side..det virker perfekt takker mange gange.
Avatar billede Ialocin Novice
10. juni 2011 - 21:26 #14
Hej line240200

Virker det ??
Hvad sker der, hvis der er identiske prøveværdier i kolonne A ??

Mvh Nicolai
Avatar billede line240200 Nybegynder
10. juni 2011 - 22:04 #15
Jamen det lader til at fungere fint, også selv om der er identiske værdier i talrækken.
Avatar billede Ialocin Novice
10. juni 2011 - 22:55 #16
Hej Line240200

Jeg  har også lige testet det.

Og har du eksempelvis 6 tal:
1, 2, 3, 1, 4, 5 og vil trække 5 tal, så gi´r resultatet: 1, 2, 3, 4, 5.

Vil du derimod trække 6 tal, trækkes: 1, 2, 3, 4, 5, hvorefter programmet fortsætter i en uendelig løkke, da det sidste (det 6. tal)ikke findes, da de sidste ledige tal er 1, hvilket jo allerede er trukket!

Kan du bruge programmet som det er eller vil du tjekke for gengangere i tallene der kan trækkes af ... inden selve udtrækningen begynder ?

Mvh Nicolai
Avatar billede line240200 Nybegynder
11. juni 2011 - 22:50 #17
Hej Nicolai
Det er supert som det er nu, endnu en gang tak for hjælpen.
Jeg sidder og roder lidt selv for at lære VBA men har nogle problemmer med nogle User forms, kunne du ha lyst til at se det igenem?
Avatar billede Ialocin Novice
11. juni 2011 - 23:10 #18
Hej Line240200

Jeg er ikke den store haj til userforms, men jeg vil gerne kigge lidt med ... man bliver aldrig for gammel til at lære noget nyt ;0)
Du kan evt. poste det til nicolaifogt@gmail.com

Mvh Nicolai
Avatar billede line240200 Nybegynder
14. juni 2011 - 08:49 #19
Så fik jeg løst problemet ved at bruge Nicolais forslag, så endnu engang tak til ham.
Jeg skulle gerne lukke denne tråd og give Nicolai nogle point, men jeg ved simpelthen ikke hvordan jeg skal gøre?
Avatar billede line240200 Nybegynder
14. juni 2011 - 08:52 #20
Jo det lykkedes vist alligevel.
Avatar billede Ialocin Novice
14. juni 2011 - 09:16 #21
Hej Line240200

Nej ikke helt ... du gav dig selv pointene !


Mvh Nicolai
Avatar billede line240200 Nybegynder
14. juni 2011 - 09:50 #22
Hvad gør jeg så?
Avatar billede Ny bruger Nybegynder

Din løsning...

Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.

Loading billede Opret Preview
Kategori
Kurser inden for grundlæggende programmering

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester