Opgelost Celwaarde door VBA aanpassen door voorloop letters toe te voegen

[Atwist]

Hallo
Ik weet niet of de titel duidelijk is, maar wat ik er mee bedoel.
zou graag, als ik in de cellen van kolom A mijn artikelnummer ingeef dat er automatisch de letters "HD-" voorkomen te staan als ik op enter druk.
Dit kan volgens mij alleen met VBA.
Ik heb al iets dergelijks met hoofdletters.

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Column = 1 Then 'kolom D=1e kolom
Target.Value = UCase(Target) 'kleine letters naar hoofdletters
End If
Application.EnableEvents = True
End Sub

Dit werkt prima en hoop nu ook iets dergelijks te vinden voor de voorloop letters

Heeft iemand hiervoor een oplossing???????

 

[snb]

Dat kan het eenvoudigst met het numberformat: "HD-0" of "HD-@"

 

[Atwist]

Hallo snb,
Bedoel je hiermee de cel eigenschappen??

 

[Atwist]

Nee, volgens mij moet het met VBA.
Heb met mijn kennis er het onderstaande van gemaakt

Private Sub Worksheet_Change(ByVal Target As Range)
Dim format As Range
Set format = Range("A3:A300")
format.NumberFormat = "HD-" 'Voorloop text
End Sub

Krijg hiermee wel een verandering naar een datum.

 

[snb]

Ja, ik bedoel de celeigenschappen; zonder VBA.

 

[Atwist]

Ik snap er even niets meer van, ik krijg nu alleen maar Datumnotatie,
als ik het getal 1020 dan kommt er een datum uit, zie screenshot.

 

[AHulpje]

Celeigenschappen, aangepast, "HD-"0, let op de plaats van de ""

 

[Atwist]

Hallo AHulpje
Deze werkt perfect
Helaas werkt nu het Ver.zoeken niet meer, deze werkte voorheen wel.

 

[Atwist]

Nu heb ik het eens via ChatGPT geprobeerd
Die is met deze oplossing gekommen en zo als ik het met mijn kennis kan zien zou deze moeten werken, maar helaas.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range
    Dim cell As Range
    Dim fixedLetters As String
    
    ' Die Ziel-Zellen, in denen die Buchstaben hinzugefügt werden sollen
    Set rng = Range("A1:A100") ' Ändern Sie den Bereich entsprechend
    
    ' Die festen Buchstaben, die hinzugefügt werden sollen
    fixedLetters = "ABC" ' Ändern Sie die Buchstaben nach Bedarf
    
    ' Überprüfen, ob die geänderten Zellen im Zielbereich liegen
    If Not Intersect(Target, rng) Is Nothing Then
        Application.EnableEvents = False ' Ereignisse deaktivieren, um Endlosschleifen zu verhindern
        For Each cell In Intersect(Target, rng)
            ' Überprüfen, ob der Wert in der Zelle eine Zahl ist
            If IsNumeric(cell.Value) Then
                ' Füge die festen Buchstaben zur Zelle hinzu
                cell.Value = fixedLetters & cell.Value
            End If
        Next cell
        Application.EnableEvents = True ' Ereignisse wieder aktivieren
    End If
End Sub

 

[AHulpje]

Een kleine toevoeging aan je bestaande Worksheet_Change event:

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    If Target.Column = 1 Then 'kolom D=1e kolom
        Target.Value = UCase(Target) 'kleine letters naar hoofdletters
        If Left(Target, 3) <> "HD-" Then
            Target = "HD-" & Target
        End If
    End If
    Application.EnableEvents = True
End Sub

 

[Atwist]

Helaas blijft het VLOOKUP niet werken,
=IF(A31>0;VLOOKUP(A31;Artikel!$A$1:$B$191;2);" ")
Deze kijkt dus naar cel A31 maar ziet een getal staan 1001 in plaats van HD-1001 dus zal deze niets vinden in het zoek bereik.

 

[peter59]

Het lijkt mij verstandiger om nu een voorbeeld bestandje te uploaden of het origineel wat natuurlijk ontdaan is van gevoelige info.

 

[AHulpje]

Heb je het ongeveer zo gedaan?

 

[Atwist]

Ik heb hier nu een voorbeeld bestandje

 

[emields]

zoiets? Dat is het voordeel van een voorbeeldbestandje.

 

[AHulpje]

Zet de celeigenschappen van kolom A op standaard en plaats "Application.EnableEvents = False" op deze regel:

    If Target.Column = 1 Then 'kolom D=1e kolom
        Application.EnableEvents = False

Het commentaar "kolom D = 1e kolom" komt mij ietwat vreemd voor.

 

[Atwist]

Dankje dit werkt

 

[Atwist]

Helaas werkt het nog niet echt lekker, zowel de bijdrage van emields als van AHulpje.
Beide werken prima zo lang je maar niet een cel leeg maakt en deze dan weer van nummer voorziet dan gaan bei de mist in.

 

[emields]

doe het dan zo.

 

[Atwist]