udskift funktionen

I arkmodulet

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("C1")) Is Nothing Then ' er kun lavet til C1
Range("A1").Value = Skift(Target.Value, Range("A1").Value)
End If
End Sub

i et modul

Public Function Skift(Hvad, Hvor)
Skift = Replace(Hvor, Right(Hvad, 2) & " ", "")
End Function


den virker kun ved ændring i C1 i øjeblikket, hvis den skal gælde andre steder, så fortæl.

OK
det fatter jeg ikke noget som helst af.
Jeg er kun nybegynder og kan kun forholde mig til fomrmler angivet i formellinjen.
Kan du ikke bøje det i Neon for mig. Hvor skal jeg skrive det der henne??
Håber du vil hjælpe
hilsen den hjælpeløse

den store kode skal være i arkmodulet,
Højreklik på fanen af det ark koden skal virke i og vælg vis programkode

sæt dette ind på det hvide område

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("C1")) Is Nothing Then ' er kun lavet til C1
Range("A1").Value = Skift(Target.Value, Range("A1").Value)
End If
End Sub


Oppe i menulinien vælger du nu
Insert > module

Nu kan du se ovre under arkene til venstre står Module1.

Se nu er Module1 makeret med grå baggrund, det er her den anden del skal være

Public Function Skift(Hvad, Hvor)
Skift = Replace(Hvor, Right(Hvad, 2) & " ", "")
End Function


Luk VBA editoren ved at trykke på det øverste X, så kommer du tilbage til arket.

koden kører automatisk når du ændrer i C1

OK det var bedre....
men formlen gør kun delvis, hvad jeg havde tænkt mig. Hvis jeg eksempelvis skriver "AC", så fjerner "AC" sig; men hvis jeg sletter "AC" igen fra C1 skulle "AC" komme frem igen i A1. Og af en eller anden mystisk årsag sletter den mellemrummene mellem initialerne i A1 når jeg sletter "AC" i C1. Den skal også virke andre steder, så er det simpelt, så må du meget gerne vise mig det.
Og tusinde tak for hjælpen.
mainframe

Slet de andre koder og sæt denne i arkmodulet

Dim GL As String
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("C1")) Is Nothing Then ' er kun lavet til C1
    If Target.Value = "" And GL <> "" Then
    Range("A1").Value = GL & " " & Range("A1").Value
    GL = ""
    Exit Sub
End If
If Target.Value <> "" And Target.Value <> GL Then
Range("A1").Value = UCase(GL) & " " & Replace(Range("A1").Value, Right(Target.Value, 2) & " ", "")
GL = Target.Value
End If
End If
End Sub

ok, nu virker det rigtig fint
nu skal jeg bare kunne udskifte initialerne i A1, både i C1, C2, C3, C4,C5....
sådan at der ikke er flere initialer tilbage i A1.

Så skal jeg nok belønne med flere point tillige med

ny kode

Dim GL(5) As String

Private Sub Worksheet_Activate()
For i = 1 To 5 ' Læser værdierne i C1 til C5 ind, for at huske dem hvis de ændres
GL(i) = Right(Cells(i, 3), 2)
Next
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("C1:C5")) Is Nothing Then ' er lavet til C1-c5
    Target.Value = UCase(Target.Value)
       
        If Target.Value = "" And GL(Target.Row) <> "" Then
        Range("A1").Value = GL(Target.Row) & " " & Range("A1").Value
        GL(Target.Row) = ""
        Exit Sub
    End If
   
    If Target.Value <> "" And Target.Value <> GL(Target.Row) Then
        If GL(Target.Row) <> "" Then
        Range("A1").Value = UCase(GL(Target.Row)) & " " & Replace(Range("A1").Value, Right(Target.Value, 2) & " ", "")
        GL(Target.Row) = Right(Target.Value, 2)
        Else
        Range("A1").Value = Replace(Range("A1").Value, Right(Target.Value, 2) & " ", "")
        GL(Target.Row) = Right(Target.Value, 2)
        End If
    End If
End If
End Sub

du skal slutte med et mellemrum efter sidste bogstav i A1, for at det virker 100%

Hvis der i A1 står "AC BE DE KO BI"
Så skal eksempelvis "AC" både fosvinde når "AC" eller "* AC" skrives.
Problemet er også, hvis man skriver forkert i C1:C5 og sletter igen, så kommer det forkerte til at stå i A1.

Jeg tager på 14 dages ferie, men jeg glemmer ikke. Du skal nok få pointene.

Dim GL(5) As String

Private Sub Worksheet_Activate()
For i = 1 To 5 ' Læser værdierne i C1 til C5 ind, for at huske dem hvis de ændres
GL(i) = Right(Cells(i, 3), 2)
Next
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("C1:C5")) Is Nothing Then ' er lavet til C1-c5
Application.EnableEvents = False
Dim A As Variant, OK As Boolean
OK = False
    Target.Value = UCase(Target.Value)
    A = Split(Range("A1"), " ")
    For i = 0 To UBound(A)
    If A(i) = Right(Target.Value, 2) Then
    OK = True
    Exit For
    End If
    Next
    If OK Or Target.Value = "" Then
        If Target.Value = "" And GL(Target.Row) <> "" Then
        Range("A1").Value = GL(Target.Row) & " " & Range("A1").Value
        GL(Target.Row) = ""
        Application.EnableEvents = True
        Exit Sub
    End If
   
    If Target.Value <> "" And Target.Value <> GL(Target.Row) Then
        If GL(Target.Row) <> "" Then
        Range("A1").Value = UCase(GL(Target.Row)) & " " & Replace(Range("A1").Value, Right(Target.Value, 2) & " ", "")
        GL(Target.Row) = Right(Target.Value, 2)
        Else
        Range("A1").Value = Replace(Range("A1").Value, Right(Target.Value, 2) & " ", "")
        GL(Target.Row) = Right(Target.Value, 2)
        End If
    End If
    Else
    MsgBox Right(Target.Value, 2) & " er ikke på listen i A1" & vbCrLf & " Tast om", vbOKOnly
    Range(Target.Address).Activate
    End If
    Application.EnableEvents = True
End If
Application.EnableEvents = True

End Sub

Det er sku for fedt lavet
Det får du 300 point for
bare du også lige ville sige lidt om, hvordan jeg ændre til at gælde i andre celler:
Tusinde tak for hjælpen.

hvordan giver jeg de sidste point?
kan man overføre?
jeg er lidt novice i det her

det er ok med de 30 point, jeg har vist nok ;-))

hvilke andre celler ?