Gerer des formats différents au sein même d'une cellule

Bonjour à tous,

Je vous souhaite une très bonne année 2018 tout d'abord.

Je viens vers vous pour que vous puissiez m'aider à me débloquer...

Je m'explique, j'ai effectué un fichier de suivi de production au sein de mon entreprise, et le magasin rempli une colonne avec tous les manquants de cette manière : ";PXXXXX*2 ;PZZZZZ*3" etc

Lorsque un manquant est débloqué le magasin note : ";PXXXXX*2 ;PZZZZZ*3"

La macro suivante me permet de récupérer tous les manquants pour les envoyer sur une autre feuille plus esthétique :

    Dim Tableau() As String
    Dim i As Integer
    Dim z As String
    Dim ligne As Long
    Dim derlig As Long
    Sheets("Manquant").Activate
    ligne = Sheets("Base").Range("AG" & Rows.Count).End(xlUp).Row 'on detecte la derniere ligne
    Sheets("Manquant").Range("A2:AH1000").ClearContents 'on supprime tout ce qui était marqué dans les manquants avant
    derlig = Sheets("Manquant").Range("A" & Rows.Count).End(xlUp).Row
    For j = 2 To ligne
    'le résultat de la fonction Split est stocké dans un tableau
    Tableau = Split(Sheets("Base").Cells(j, 33), ";") 'tout ce qui est situé entre les ;
    'boucle sur le tableau pour visualiser le résultat
    For i = 1 To UBound(Tableau)
    derlig = derlig + 1
     z = Tableau(i)
    Sheets("Manquant").Cells(derlig, 3) = z 'P/N du manquant + quantité
     If Sheets("Manquant").Cells(derlig, 3).Font.Strikethrough = False Then
    Sheets("Manquant").Cells(derlig, 3) = z 'P/N du manquant + quantité
    Sheets("Manquant").Cells(derlig, 1) = Sheets("Base").Cells(j, 1) 'OF
    Sheets("Manquant").Cells(derlig, 2) = Sheets("Base").Cells(j, 5) 'POLE
    Else
    Sheets("Manquant").Cells(derlig, 3) = ""
    End If
    Next i
    Next j

L'objectif serait de récupérer uniquement les manquants qui ne sont pas barrés.

Est-ce possible ? Si oui pouvez vous m'aider ?

Merci d'avance

Bonjour,

merci de nous mettre un fichier exemple/de test.

Voila un fichier simplifié :

La colonne des manquants est "AG" et je veux que seul les manquants non barrés apparaissent sur la feuille "Manquant"

Merci d'avance

bonsoir,

une proposition

Sub aargh()
    Set wsb = Sheets("base")
    Set wsm = Sheets("Manquant")
    dl = wsb.Cells(Rows.Count, "AG").End(xlUp).Row
    k = 1
    For i = 2 To dl
        Set s = wsb.Cells(i, "AG")
        For j = 1 To Len(s)
            c = Mid(s, j, 1)
            If c = ";" Then
                If st Then
                    k = k + 1
                    wsm.Cells(k, 2) = nr
                    wsm.Cells(k, 1) = wsb.Cells(i, 1)
                    wsm.Cells(k, 3) = wsb.Cells(i, 2)
                End If
                nr = ""
                st = False
            Else
                nr = nr & c
                If s.Characters(j, 1).Font.Strikethrough = True Then st = True
            End If
        Next j
    Next i
End Sub

Merci de ta réponse,

On voit qu'il y a du progrès mais cela ne marche pas completement, pourrais tu me détailler ton code avec des commentaires pour que je puisse comprendre et voir si je peux améliorer ?

Merci d'avance

bonjour

voici un code corrigé et commenté. je me suis rendu compte que le code précédent proposé faisait le contraire de ce que tu avais demandé.

Sub aargh()
    Set wsb = Sheets("base")
    Set wsm = Sheets("Manquant")
    dl = wsb.Cells(Rows.Count, "AG").End(xlUp).Row 'dernière ligne wsb
    k = 1 'pointeur ligne sur manquant
    For i = 2 To dl 'on parcourt les lignes de wsb
        Set cel = wsb.Cells(i, "AG") ' cel pointe sur la cellule en cours dans la colonne AG
        s = Trim(cel.Value & ";") ' s contenu de la cellule en cours
        For j = 1 To Len(s) 'on passe en revue chaque caractère de s
            c = Mid(s, j, 1) ' c caractère en cours
            If c = ";" Then 'si  fin de pole détectée
                If st And nr <> "" Then ' pole à prendre et pole non vide
                    k = k + 1 ' on incrémente le pointeur de ligne k
                    wsm.Cells(k, 2) = nr 'on met les infos dans la ligne k
                    wsm.Cells(k, 1) = wsb.Cells(i, 1)
                    wsm.Cells(k, 3) = wsb.Cells(i, 2)
                End If
                nr = "" 'on commence un nouveau pole
                st = False 'le pole par défaut n'est pas à prendre
            Else
                nr = nr & c ' on reconstitue le pole
                If cel.Characters(j, 1).Font.Strikethrough = False Then st = True ' si caractère non barré, pole à reprendre
            End If
        Next j
    Next i
End Sub

Excellent !

Merci 100 fois à toi.

Passe une bonne journée