Avatar billede Skovby Novice
16. marts 2021 - 07:50

Hjælp! Fejl i kode, kontrolfunktion virker ikke!

Jeg skal have lavet en god slat bankoplader via en Excel database med 27 rækker - en række for hver plade.

En bankoplade har 27 felter fordelt på 3 rækker.
Første kolonne cifre fra 1-9, anden række cifre fra 10-19 osv.
Hver række skal indeholde 5 cifre, altså 15 cifre på en hel plade
De resterede 12 felter er tomme på tilfældige pladser.

Jeg har fundet nedenstående VBA kode, men en der har testkørt den, melder tilbage at den har lavet to rækker, der indeholder samme 15 cifre, hvilket er det jeg vil undgå. Koden skal altså, inden den skriver en ny række, kontrollere at der ikke allerede er en række med samme 15 cifre i de 27 celler. Vær opmærksom på at cifrene kan stå i varierende celler i rækken, da de 12 tomme celler placeret tilfældigt.


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 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