Formel - fordel et givet tal ift en prioritet

Tallene 1 til 18 i rækkefølge i fra A1 og nedad
Tallet der skal fordeles i C1

Makroen skriver i B kolonnen

Public Sub Fordel18()
Dim Tal As Integer, Antal As Integer, I As Integer
Antal = 18
Tal = [C1].Value
Range("B1:B18").ClearContents
Do
For I = 1 To 18
Range("B" & I) = Range("B" & I) + 1
Tal = Tal - 1
If Tal = 0 Then Exit Sub
Next
Loop Until Tal = 0
End Sub

ser ud til at virke. En lille detalje, ville egentligt godt have macroen i B kolonnen til at køre automatisk, når tallet i C1 tastes ind, kan det fikses ?

Cybershot

Et lille spørgsmål fra en nybegynder på siten.

"kommentar" er det hvis man vil have specificeret svaret på ens spørgsmål inden man giver points ?
"Svar" er det accept af svar på ens spørgsmål og dermed tildeling af points ?

Cybershot

Sæt denne i Arkets modul

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$C$1" Then ' ret til den celle du skriver tallet i
Dim Tal As Integer, Antal As Integer, I As Integer
Antal = 18
Tal = Target.Value
Range("B1:B18").ClearContents
Do
For I = 1 To 18
Range("B" & I) = Range("B" & I) + 1
Tal = Tal - 1
If Tal = 0 Then Exit Sub
Next
Loop Until Tal = 0
End If
End Sub

Som spørger, bruger man kun kommentar, svar bruges kun hvis man selv har fundet svaret og at man tager udlovede point retur.

Jeg svarer nu, så kan du give mig point, ved at markere mit navn i boksen til venstre og så tryk Accepter.

Har forsøgt at sætte følgende ind i macro modulet:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$C$1" Then ' ret til den celle du skriver tallet i
Dim Tal As Integer, Antal As Integer, I As Integer
Antal = 18
Tal = Target.Value
Range("B1:B18").ClearContents
Do
For I = 1 To 18
Range("B" & I) = Range("B" & I) + 1
Tal = Tal - 1
If Tal = 0 Then Exit Sub
Next
Loop Until Tal = 0
End If
End Sub

men kan ikke få det til at fungere.

cybershot

Den skal i ARK modulet.
højreklik på arkfanen i det ark den skal virke, vælg vis programkode.
Der skal den være.

Det hjalp. Glemte bare lige en ting i farten kolonne A1 og ned til A18 er tilfældigt fordelt og altså ikke stigende fra 1 (A1) til 18 (A18).

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$C$1" Then    ' ret til den celle du skriver tallet i
        Dim Tal As Integer, Antal As Integer, I As Integer, C As Integer
        Antal = 18
        Tal = Target.Value
        Range("B1:B18").ClearContents
        Do
            For I = 1 To 18
                For C = 1 To 18
                    If Range("A" & C) = I Then
                        Range("B" & C) = Range("B" & C) + 1
                        Tal = Tal - 1
                    End If
                    If Tal = 0 Then Exit Sub
                Next
            Next
        Loop Until Tal = 0
    End If
End Sub

thks, det virker.

Cybershot