Autoudfyld celle når celle er oprettet som en datavalideringslist

Hvis der er andre måder at klare problemet med begrænsning af indtastningsværdier end datavalidering samtidig med at man får cellen autoudfyldt er sådan et løsningsforslag selvfølgelig også velkommen

Der skal bare lige nævnes at der er ca. 5000 celler der er begrænset af den samme liste..

Prøv at sætte denne makro ind i arkets modul, ret den selv til, den kan ikke arbejde sammen med datavalidering.

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Range("A1:A500")) Is Nothing Then ' ret til det område som den skal virke på
        Application.EnableEvents = False
        Select Case Target.Value
        Case 1
            Target = "Tekst1"
        Case 2
            Target = "Tekst2"
        Case 3
            Target = "Tekst3"
        Case Else
            MsgBox " Fejl i indtastning ( tallene 1,2 og 3) er gyldige"
            Target.Select
        End Select
        Application.EnableEvents = True
    End If
End Sub

Da der er rigtig mange tal og tekster at vælge imellem er det min mening at man skal kunne se valgmulighederne på en liste (f.eks. fra en valideringsliste eller andet) inden man vælger et tal kan det lade sig gøre?

Er de 5000 celler i et "mønster", der kan lokaliseres - så vil det nok være muligt at indsætte valideringsværdierne automatisk via VBA-kode.

Ja, de står i en kolonne i rækkerne 3-5000, hvis det er det du mener

Ok - d.v.s. at en makro kan indsætte den samme valideringslistei samtlige celler i rækker 3-5000 - hvilken kolonne?

den står i kolonne h

sender også modellen til dig direkte....
Værdierne indsættes i et anden fil - jfr. beskrivelsen i koden - (årsagen har været anvendt i anden forbindelse)

Dim liste, xls, xsti
Sub start()
    hentSti
    r = findOmråde
   
    liste = "IV1:IV" + CStr(r)

Rem indsæt validerings-værdier i rækkerne 3 - 5000 - kolonne 8 (H)
    For ræk = 3 To 5000
            sætValidering ræk, 8
    Next ræk
   
    MsgBox ("Valideringsværdier er indsat")
End Sub
Private Sub hentSti()
    xsti = ActiveWorkbook.Path
    If Right(xsti, 1) <> "\" Then
        xsti = xsti + "\"
    End If
End Sub
Private Function findOmråde()                      'henter validitetsværdier i andet ark - benævnt Validiteter.xls
Dim ræk, kol, r                                    'indsætter validitetsværdierne i kolonne 256 (IV) i "bruger-filen"
   
    Set xls = CreateObject("Excel.Application")
    With xls
        .Workbooks.Open (xsti + "validiteter.xls")
            For ræk = 1 To 9999
                If .Cells(ræk, 1) = "" Then
                    xls.Application.Quit
                    Set xls = Nothing
                    findOmråde = ræk - 1
                    Exit Function
                Else
                    ActiveWorkbook.Sheets(1).Cells(ræk, 256) = .Cells(ræk, 1)
                End If
            Next ræk
    End With
End Function
Private Sub sætValidering(r, k)
    Cells(r, k).Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=" & liste
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
End Sub

ups, denen havde jeg glemt
Kan jeg få et svar fra dig suertekst

supertekst :-)

Det får du her..