Avatar billede Skovby Novice
14. marts 2021 - 17:14 Der er 10 kommentarer og
1 løsning

Kode til Bankoplader (med kontrol for dubletter)

Jeg skal have lavet en masse bankplader via en Excel database med 27 rækker for hver plade. Jeg har i et forum på nettet fundet en VBA kode jeg tror virker, men jeg er lidt bekymret for at den kontrollerer for dubletter. Er der klog mand/kvinde i dette forum, der kan hjælpe med svar? Koden er nedenfor.

Option Base 1
Option Explicit

Sub main()
Dim lAntal As Long, s As Long
lAntal = Application.InputBox("Hvor mange plader ?")
For s = 2 To lAntal + 1
   
    Range("D" & s & ":AD" & s) = Make27Numbers

Next
End Sub


Function Make27Numbers()
Dim TmpArray(27)
Dim k As Long, z As Long, i As Long, j As Long, x As Long, y As Long
k = 0
z = 0
For i = 0 To 80 Step 10
    j = 0
    While j < 3
        If i = 0 Then y = 1 Else y = 0
        If i = 80 Then z = 1 Else z = 0
        x = rndbetween(i + y, i + 9 + z)
        If Not IsInArray(TmpArray, x) Then
            k = k + 1
            TmpArray(k) = x
            j = j + 1
        End If
    Wend
Next
BubbleSort TmpArray()
PickOut15 TmpArray
Make27Numbers = TmpArray
End Function


Function IsInArray(MyArray, TestValue)
IsInArray = IIf(UBound(Filter(MyArray, TestValue)) < 0, False, True)
End Function


Function rndbetween(low, high)
Dim tmp As Long
tmp = high - low + 1
rndbetween = Int(Rnd() * tmp) + low
End Function


Sub PickOut15(list())
Dim skema(3, 9)
Dim i As Long, j As Long, lRow As Long, lCol As Long, x As Long
Dim tal5 As Long, tal3 As Long
Randomize Timer
For i = 1 To 3
    For j = 1 To 9
        skema(i, j) = 1
    Next
Next
Do Until x = 12
    lRow = Int(Rnd() * 3) + 1
    lCol = Int(Rnd() * 9) + 1

    If skema(lRow, lCol) = 0 Then GoTo hop
    skema(lRow, lCol) = 0
    tal5 = 0
    tal3 = 0
    For i = 1 To 9
        tal5 = tal5 + skema(lRow, i)
    Next
    For i = 1 To 3
        tal3 = tal3 + skema(i, lCol)
    Next
    If (tal5 >= 5 And tal3 >= 1) Then x = x + 1 Else skema(lRow, lCol) = 1
hop:
Loop
x = 0
For i = 1 To 9
    For j = 1 To 3
        x = x + 1
        If skema(j, i) = 0 Then list(x) = "TOM"
    Next
Next
End Sub


Sub BubbleSort(list())
    Dim First As Integer, Last As Long
    Dim i As Long, j As Long
    Dim Temp As Long
   
    First = LBound(list)
    Last = UBound(list)
    For i = First To Last - 1
        For j = i + 1 To Last
            If list(i) > list(j) Then
                Temp = list(j)
                list(j) = list(i)
                list(i) = Temp
            End If
        Next j
    Next i
End Sub
Avatar billede claes57 Ekspert
14. marts 2021 - 18:59 #1
Det står sikkert beskrevet på det forum, hvor du fandt koden.

"lidt bekymret for at den kontrollerer for dubletter" så det vil du ikke have, at den gør?
"lidt bekymret for om den kontrollerer for dubletter" du vil gerne have kontrollen?
de små ord har en stor virkning...
Avatar billede Skovby Novice
14. marts 2021 - 19:08 #2
Undskyld. Dårligt formuleret. Jeg vil naturligvis gerne have undgå at der er dubletter og dermed vil jeg gerne have den til at kontrollere, så det undgåes.

Jeg fandt koden i et forum og sidste kommentar i den tråd var 14 år gammel, så der var ikke mere hjælp at hente.
Avatar billede claes57 Ekspert
14. marts 2021 - 19:12 #3
den tester...
funktionen IsInArray(MyArray, TestValue)
sørger for, at dubletter ikke kommer med.
Avatar billede Skovby Novice
14. marts 2021 - 19:30 #4
OK, fantastisk. Bare så jeg forstår det rigtigt, så skriver den ikke en ny række, hvis der er allerede er en række de indeholder samme cifre - også selvom cifrene ikke står i samme celler.
Avatar billede claes57 Ekspert
14. marts 2021 - 19:53 #5
Det er så der, sortering kommer ind. Den sorterer alle tal i stigende rækkefølge før den tjekker, om der er en magen til.
Avatar billede Skovby Novice
15. marts 2021 - 17:55 #6
Hmm ... Skrev i et andet forum hvor en svarede:

"I stedet for at bruge en masse krudt på at tolke koden, prøvede jeg en kørsel, hvor jeg bare bad om 10 bankoplader, og det gav 2 identiske plader. Det er nok ikke særlig sandsynligt, men det skete altså i første forsøg. Ergo: Der er ingen kontrol (eller også virker den ikke, som den skal)."

Nu bliver jeg lidt urolig ...
Avatar billede claes57 Ekspert
15. marts 2021 - 18:42 #7
ok, testet af ukendt - så er der kodefejl i en af rutinerne - find en anden kode, eller  ret i koden.
Hvis der er én, der skriver fejl, så tag det for rigtigt, og gå videre.
Urolig hjælper ikke nogen...
Jeg valgte at tro på at rutinerne virkede ud fra deres navn - det gør de så åbenbart ikke.
Avatar billede Skovby Novice
15. marts 2021 - 18:55 #8
Mange tak for svar. Kan desværre ikke selv skrive kode, netop derfor spørger jeg om hjælp, først og fremmest for at få be- eller afkræftet at koden virker efter hensigten. Det lader det så ikke til. Derfor søger jeg hjælp til at rettte fejlen, så jeg får en brugbar kode. Har søgt nettet tyndt og kan ikke finde nogen der kan hjælpe :/

Nogen idéer?
Avatar billede claes57 Ekspert
15. marts 2021 - 19:25 #9
Start et nyt spørgsmål., og skriv, at denne kode ikke virker (der er ingen grund til andet). Men hvis nogen har en idé til hvor den svigter i at frasortere dubletter, så byd ind. Link til det svar, du fik i #6 - vi vil gerne hjælpe, men hvis du sidder med data, som du ikke giver, så stopper det...
Avatar billede acore Ekspert
15. marts 2021 - 19:27 #10
Skal det være VBA - siær vis du ikke kan det så godt, er det måske nemmere bare med formler?

Se https://www.got-it.ai/solutions/excel-chat/excel-tutorial/random/how-to-use-the-randbetween-function-with-no-duplicates, som du kan bruge til at generere 27  tillfældige tal mellem 1 og 90 uden dubletter.
Avatar billede claes57 Ekspert
15. marts 2021 - 20:21 #11
Der skal så være en plade med 27 tal uden dubletter, og så laves fx 100 plader en aften, igen ikke to ens. Al kode tester åbenbart kun på en plade, men kan ikke lave en serie til en hel aften i bankohallen.
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

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





Premium
Test: Derfor vil jeg gerne have Google ind i min næste bil - og det er dårligt nyt for nogle bilproducenter
Googles Android Automotive er et vellykket styresystem til bilen, der vender op og ned på magtbalancen i bilbranchen. Computerworld har prøvekørt softwaren og har dommen klar.
CIO
Har du rost din mellemleder i dag? Snart er de uddøde - og det er et tab
Computerworld mener: Mellemledere lever livet farligt: Topledelsen får konstant ideer med skiftende hold i virkeligheden, og moden går mod flade agile organisationer. Men mellemlederen er en overset hverdagens helt med et kæmpe ansvar. Her er min hyldest til den ofte latterliggjorte mellemleder.
Job & Karriere
Eva Berneke stopper som topchef i KMD og flytter til Paris: Her er KMD's nye topchef
Efter syv år på posten som topchef for KMD forlader Eva Berneke selskabet. Nu flytter hun med familien til Paris, hvor hun vil fortsætte sit bestyrelsesarbejde. KMD har allerede afløser på plads.
White paper
Udnyt ressourcerne bedre og skru op for overskuddet
Spildt arbejde, ineffektive processer og ringe forretningsindsigt er blot tre tegn på ringe ressourceudnyttelse. I dette whitepaper får du viden om, hvordan du måler ressourceudnyttelsen – og bruger indsigten operationelt, taktisk og strategisk.