14. marts 2021 - 17:14Der 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
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...
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.
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.
"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)."
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.
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 :/
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...
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.
Synes godt om
Ny brugerNybegynder
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.