05. juni 2011 - 14:13Der 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
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
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.
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 ??
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.
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
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
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 ?
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?
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
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?
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.
