opskrive en talrække ud fra hvilke tal der mangler fra 1-9

Prøv med denne lille stump kode:

Sub test19()

Mangler = 0
For i = 1 To 9
    Fundet = False
    For Each c In Range("B5:J5")
        If i = c Then
            If Fundet Then
                MsgBox "Dobbeltindtastning (" & i & ")", vbCritical + vbOKOnly, "Fejl"
            Else
                Fundet = True
            End If
        End If
    Next c
    If Not Fundet Then
        Mangler = Mangler + 1
        Cells(5, 13 + Mangler).Value = i
    End If
Next

End Sub

Hej sjap
Hvor skal jeg skrive den kode henne ?

Tryk Alt-F11, vælg menuen Indsæt/Modul og kopier ovenstående kode ind her.

Hereften kan programmet køres, når du i regnearket trykker Alt-F8.

Du kan også oprette en kommandoknap i regnearket, så du kan aktivere funktionen ved tryk på den.

Ok tak for det, kan koden ikke udvides til at fortsætte til næste række og gøre det samme, altså i b6:j6 og skrive de der mangler fra n6-v6 ???

Sub test19()

For j = 5 To 6
    Mangler = 0
    For i = 1 To 9
        Fundet = False
        For Each c In Range("B" & j & ":J" & j)
            If i = c Then
                If Fundet Then
                    MsgBox "Dobbeltindtastning (" & i & ")", vbCritical + vbOKOnly, "Fejl"
                Else
                    Fundet = True
                End If
            End If
        Next c
        If Not Fundet Then
            Mangler = Mangler + 1
            Cells(j, 13 + Mangler).Value = i
        End If
    Next i
Next j

End Sub

for nu at være rigtig besværlig kan man så få den til at, hvis man indsætter et tal i rækken b5:j5, kan den så fjerne den fra rækken n5:v5???

Jeg kan ikke rigtig få en kommandoknap til at fungere kan du også hjælpe med det ??

og hvad hvis man gerne vil have den til at fungere lodret altså fra b5:b13 og skrive de manglende tal op fra b17:b25 og så fortsætte til den kolonne C??

Du finder da også hele tiden på noget nyt! Jeg kan godt lave funktionen automatisk - så behøver du ikke knappen. Du skal blot lige ændre funktionen til

Sub test19()

Range("N5:V6").Clear
For j = 5 To 6
    Mangler = 0
    For i = 1 To 9
        Fundet = False
        For Each c In Range("B" & j & ":J" & j)
            If i = c Then
                If Fundet Then
                    MsgBox "Dobbeltindtastning (" & i & ")", vbCritical + vbOKOnly, "Fejl"
                    Cells(j, 13 + Mangler) = "Dobbeltindtastning"
                Else
                    Fundet = True
                End If
            End If
        Next c
        If Not Fundet Then
            Mangler = Mangler + 1
            Cells(j, 13 + Mangler).Value = i
        End If
    Next i
Next j

End Sub


Derefter højreklikker du på fanebladet på regnearket, hvor du skriver dine tal. Vælg "Vis programkode" og i det vindue, der dukker frem skriver du følgende


Private Sub Worksheet_Change(ByVal Target As Excel.Range)

If Target.Row = 5 Or Target.Row = 6 Then
    If Target.Column >= 2 And Target.Column <= 10 Then
        test19
    End If
End If

End Sub

jeg syntes ikke den virker automatisk, og jeg vil gerne have den til at virke fra b5 og fortsætte til række b13, og hvad med at få den til at fungere lodret? ja ja jeg ved godt men jeg kan jo ikke selv finde ud af det. og jeg ved godt det er meget at forlange men du er jo mesteren.

Den lodrette var lige smuttet. Det må kunne klares med denne her:

Sub Test19Lodret()

Range("B17:C25").Clear
For j = 2 To 3
    Mangler = 0
    For i = 1 To 9
        Fundet = False
        For Each c In Range(Cells(5, j), Cells(13, j))
            If i = c Then
                If Fundet Then
                    MsgBox "Dobbeltindtastning (" & i & ")", vbCritical + vbOKOnly, "Fejl"
                    Mangler = Mangler + 1
                    Cells(16 + Mangler, j) = "Dobbeltindtastning (" & i & ")"
                Else
                    Fundet = True
                End If
            End If
        Next c
        If Not Fundet Then
            Mangler = Mangler + 1
            Cells(16 + Mangler, j).Value = i
        End If
    Next i
Next j

End Sub

Nåh, ja så skal automatikken lige ændres til:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

If Target.Column = 2 Or Target.Column = 3 Then
    If Target.Row >= 5 And Target.Row <= 13 Then
        Test19Lodret
    End If
End If

End Sub

Hvis du ikke kan få det til at virke, så læg en mail-adresse, så sender jeg mit ark.

det ser ud til at automatikken virker i den lodrette men ikke i den vandrette, min e-mail er vinther@larsen.mail.dk

Regneark sendt.

jeg har sendt et regneark til dig hvor du måske kan se hvad jeg gerne vil kunne gøre

men hvis du vil svare mig tilbage så svar tilbage på vinther@larsen.mail.dk

Er det meningen at den skal gøre det for række 1 - 2 og kolonne B - C (som du har beskrevet ovenfor) eller skal det gøres for alle rækker (5 - 13) og alle kolonner (B - J)?

for alle rækker og alle kolonner, jeg troede at jeg selv kunne udvide koden hvis det kom til at virke for de to rækker, men nej det kan jeg ikke

I farten glemte jeg lige at ændret "automaten" - der skal stå sådan her i stedet:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

If Target.Row >= 5 And Target.Row <= 13 Then
    If Target.Column >= 2 And Target.Column <= 10 Then
        Test19Vandret
        Test19Lodret
    End If
End If

End Sub

Jeg kan se, der er lidt mere jeg har glemt at rette. Jeg sender lige et nyt ark.

I virkeligheden er en del af rettelserne ret enkle:

Sub Test19Vandret()
Range("N5:V13").ClearContents
For j = 5 To 13

N5:V13 er det område hvor de manglende tal skrives (her stod tidligere "N5:V6").
Koden gennemløber række for række tallene i række 5 til 13 (her stod tidligere 5 til 6).

Sub Test19Lodret()
Range("B17:J25").ClearContents
For j = 2 To 10

B17:J25 er det område hvor de manglende tal skrives (her stod tidligere "B17:C25").
Koden gennemløber kolonne for kolonne tallene i kolonne 2 (dvs. B) til 10 (dvs. J) (her stod tidligere 2 til 3).

Herudover er der så ændret i "Worksheet_Change" sub'en som beskrevet ovenfor - den er faktisk blevet mere enkel.

tusinde tak for hjælpen jeg giver dig hermed dine fortjente points tak tak tak