Conserver uniquement les premières lettres d'une variable

Bonjour!
J'aimerais optimiser un peu ce code que j'ai créé afin de conserver les premiers caractères d'une variable. Je sais, c'est du travail d'amateur. J'imagine qu'il doit y avoir une façon plus élégante de le faire.

Je vais détailler un peu le but de la macro. La variable est un "numéro de production", qui est unique et qui respecte habituellement des règles de nommage. Voici quelques exemples...
SL1
X001
TEST001
TEST1X04
TEST20210504B
TEST044A
TEST055B-1_2
TEST066C;1_3
EXEMPLETEST

Comme vous le voyez, un numéro de production est habituellement composé d'un préfixe constitué de lettres majuscules non accentuée, d'un nombre variable de caractères, et immédiatement suivi d'au moins un chiffre et éventuellement d'autres lettres. Les autres caractères qui peuvent composer ce numéro de production sont spécifiquement choisis pour ne pas interférer avec le VBA ou le batch.

Un numéro de production peut aussi être constitué d'une simple suite de lettres.

Ce bout de macro sert donc à éliminer tout ce qui se trouve après la dernière lettre du préfixe. J'aimerais trouver une solution plus simple que ce bricolage.

Dim fichierprod

fichierprod = Target.Value

fichierprod = Replace(fichierprod, ";", ";;;;;;;;;;;;;;;")

fichierprod = Replace(fichierprod, "1", ";;;;;;;;;;;;;;;")

fichierprod = Replace(fichierprod, "2", ";;;;;;;;;;;;;;;")

fichierprod = Replace(fichierprod, "3", ";;;;;;;;;;;;;;;")

fichierprod = Replace(fichierprod, "4", ";;;;;;;;;;;;;;;")

fichierprod = Replace(fichierprod, "5", ";;;;;;;;;;;;;;;")

fichierprod = Replace(fichierprod, "6", ";;;;;;;;;;;;;;;")

fichierprod = Replace(fichierprod, "7", ";;;;;;;;;;;;;;;")

fichierprod = Replace(fichierprod, "8", ";;;;;;;;;;;;;;;")

fichierprod = Replace(fichierprod, "9", ";;;;;;;;;;;;;;;")

fichierprod = Replace(fichierprod, "0", ";;;;;;;;;;;;;;;")

fichierprod = Replace(fichierprod, "-", ";;;;;;;;;;;;;;;")

fichierprod = Replace(fichierprod, "_", ";;;;;;;;;;;;;;;")

fichierprod = Left(fichierprod, 20)

fichierprod = Replace(fichierprod, ";", "")

J'en profite pour remercier ceux qui m'ont aidé jusqu'à maintenant. J'ai beaucoup progressé en VBA grâce à vous!

Bonjour,

A tester :

Function ProdNum(ByVal NumeroProduction As String) As String

Dim I As Integer

    ProdNum = ""
    For I = 1 To Len(NumeroProduction)
        Select Case Mid(NumeroProduction, I, 1)
               Case Chr(65) To Chr(90)
                  ProdNum = ProdNum & Mid(NumeroProduction, I, 1)
               Case Else
                  Exit Function
        End Select
    Next I

End Function

Désolé, je ne vois pas comment intégrer ton code à ma macro.

Salut,

Eric t'as fait une fonction sur mesure dans ton code tu remplaces l'usine à gaz par le sien
Je vois que tu as Target.Value donc si tu es dans l'évènement Change de la feuille faudra peut-être adapter le code.

Dim fichierprod
fichierprod = ProdNum(Target.Value)

Malheureusement ça ne fonctionne pas. J'ai tout essayé pour l'adapter.

Ce n'est pas beaucoup plus élégant, mais j'ai réussi à alléger un peu la procédure et je ne risque plus de dépassement de longueur de variable. Le code est un peu plus rapide et compte tenu de la performance de l'ordinateur qui va l'exécuter, je crois que c'est acceptable.

En tous cas, merci.

Dim fichierprod

fichierprod = Target.Value

fichierprod = Replace(fichierprod, "1", ";")

fichierprod = Replace(fichierprod, "2", ";")

fichierprod = Replace(fichierprod, "3", ";")

fichierprod = Replace(fichierprod, "4", ";")

fichierprod = Replace(fichierprod, "5", ";")

fichierprod = Replace(fichierprod, "6", ";")

fichierprod = Replace(fichierprod, "7", ";")

fichierprod = Replace(fichierprod, "8", ";")

fichierprod = Replace(fichierprod, "9", ";")

fichierprod = Replace(fichierprod, "0", ";")

fichierprod = Replace(fichierprod, "-", ";")

fichierprod = Replace(fichierprod, "_", ";")

fichierprod = Replace(fichierprod, ":", ";")

fichierprod = Left(fichierprod, InStr(fichierprod, ";") - 1) & "_"

Salut,

Je pense que ça ne fonctionne pas, n'est pas une réponse en soit.
Quel est le message d'erreur, ou quel est la valeur qui ne correspond pas, il serait intéressant d'en savoir un peu plus.

Bonjour,
Une proposition à adapter !?
Cdlt.

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim lastRow As Long, txt As String
    lastRow = Me.Cells(Rows.Count, 1).End(xlUp).Row
    If Not Intersect(Target, Me.Cells(1).Resize(lastRow)) Is Nothing And Target.Count = 1 Then
        If Not IsEmpty(Target) Then
            txt = Target.Value
            txt = RemoveCharacters(txt)
            Target.Offset(, 2).Value = txt
        End If
    End If
End Sub

Private Function RemoveCharacters(txt As String) As String
    With CreateObject("VBScript.RegExp")
        .Global = True
        .Pattern = "[^A-Z]"
        RemoveCharacters = .Replace(txt, "")
    End With
End Function

Pour SG394 :

Quelle est la colonne où doit s'appliquer le code et sur quelle colonne mettre le résultat ?

Salut à tous

@sg394 J'ai modifier la fonction d'Eric pour englober les premiers caractères alphanumériques de la chaine de caractères.

Mais ce n'est peut être pas ce que tu recherches