VBA Analyse d'une cellule et fractionnement

Bonjour à tous, et joyeuses fêtes par la même occasion,

Je tiens tout d'abord remercier tous ceux qui proposent leur aide gratuitement sur ce forum qui m'a déjà aidé à maintes reprises !

Ma question est la suivante :

Dans la Feuil1 d'un excel, j'ai une valeur affichée dans la cellule A1 qui est entrée par l'utilisateur

Cette valeur est du type code à barres EAN128 :

(00)14256(01)123(02)1245

Donc elle se compose de "modules" : (XX) , dont les X peuvent aller de 0 à 9 ; suivi des valeurs que doit prendre le module (Dont la longueur est variable)

Je recherche une macro qui me permettrais lorsque je lance, d'analyser la valeur en A1, et répartir les modules dans la feuil2 d'excel.

Donc avec un exemple :

A1 de la feuil1 = (00)12345(03)111(06)L17845(30)123

Si je lance la macro :

Dans la feuil2

Cellule A2 = 12345

Cellule D2 = 111

Cellule G2 = L17845

Cellule AE2 = 123

Si j'entre une nouvelle valeur dans A1 de la Feuil1, et que je relance la macro, elle supprime les valeurs de la ligne 2 par les nouvelles et ainsi de suite.

Je joins le fichier exemple

Pouvez-vous m'aider ?

Merci

bonjour,

une solution via une fonction personnalisée

Function splitt(s, f, l, p)
    Dim a
    a = Split(s, l)
    splitt = Mid(a(p), InStr(a(p), f) + 1)
End Function

où S est le code barre

où f est le premier caractère qui délimite la chaine à trouver

où l est le dernier caractère qui delimite la chaine à trouver

où p est l'occurrence de la chaine à trouver

par exemple

=splitt(A1,")","(", 2) affiche la 2ème occurrence d'un chaine se trouvant entre les caractères ) et (

fonction incluse dans le fichier joint

Parfait !

Merci beaucoups !

J'étais partis dans un code tous compliqué qui ressemblait à cela :

Sub ExtracCodesPicto()

Dim objRange As Range
Dim Tableau() As String
Dim n%, i%, j%, t$,
Dim objRange2 As Range

    Set objRange = ActiveWorkbook.Worksheets("Feuil1").Cells(4, 5)

    objRange.Replace "(", ";("

    Tableau = Split(objRange, ";")

    For i = 0 To UBound(Tableau) - 1
        For j = i + 1 To UBound(Tableau)
            If Tableau(j) < Tableau(i) Then
                t = Tableau(i)
                Tableau(i) = Tableau(j)
                Tableau(j) = t
            End If
        Next j
    Next i
    j = 0: t = ""
    With Worksheets("Feuil2")
        For i = 0 To UBound(Tableau)
            If t <> Tableau(i) Then
                t = Tableau(i)
                j = j + 1
                .Cells(1, j).Value = t
            End If
        Next i
    End With

    Set objRange2 = ActiveWorkbook.Worksheets("Feuil2").Rows(1)
    objRange2.Replace "(00)", ""
    objRange2.Replace "(01)", ""
    objRange2.Replace "(02)", ""
    objRange2.Replace "(03)", ""
    objRange2.Replace "(04)", ""
    objRange2.Replace "(05)", ""
    objRange2.Replace "(06)", ""
    objRange2.Replace "(07)", ""
End Sub

Mais vous m'avez vraiment simplifié la vie, encore merci !

Bonjour à tous

Une autre solution qui n'a pas la finesse de celle de H2SO4 mais qui répond exactement à ce que tu as demandé.

A tester.

Bye !

Encore plus extraordinaire merci

[RéEdit]

Désolé du double post

Dans la solution de GMB, comment fait-on pour rester sur la Feuil1 à la fin de l'exécution de la macro ? (non pas se retrouver feuil2)

Bonjour

dolian007 a écrit :

comment fait-on pour rester sur la Feuil1 à la fin de l'exécution de la macro ? (non pas se retrouver feuil2

Réponse : on supprime la dernière instruction. Comme dans cette nouvelle version :

Et si cela t’intéresse, on peut faire une autre adaptation qui te permettrait de traiter de la même manière plusieurs code barre mis à la suite dans la colonne A (autant que tu veux, en fait) : un simple clic sur le bouton et tu aurais leur décompositon sur la feuille 2 …

Bye !