VBA Excel - Copier des lignes si condition

Résolu
jacktbio2 Messages postés 2 Date d'inscription   Statut Membre Dernière intervention   -  
jacktbio2 Messages postés 2 Date d'inscription   Statut Membre Dernière intervention   -
Bonjour,

Je sollicite votre aide pour réaliser une macro dans Excel 2003.

Voici mon tableau :

A..............................B
Fruit ................ Banane - L:9900 LE5:9907 10cl:9920
Légumes ........ Courgette - 30cl:3043 L:4356
Conserve ....... Sardine - L:8760 L:7883 30cl:1289 40cl:9912 40cl:9913

Je souhaiterai que pour chaque code à 4 chiffres qui suivent les ":", une ligne soit créée en dessous en recopiant la ligne et en indiquant dans la colonne C le code à 4 chiffres.
Dans toutes les lignes, les codes à 4 chiffres à utiliser sont précédées de ":".

Résultat souhaité :

A .................................B .................................................................................... C
Fruit ............... Banane - L:9900 LE5:9907 10cl:9920 ...................................... 9900
Fruit ............... Banane - L:9900 LE5:9907 10cl:9920 ...................................... 9907
Fruit ............... Banane - L:9900 LE5:9907 10cl:9920 ...................................... 9920
Légumes ....... Courgette - 30cl:3043 L:4356 ................................................... 3043
Légumes ....... Courgette - 30cl:3043 L:4356 ................................................... 4356
Conserve ....... Sardine - L:8760 L:7883 30cl:1289 40cl:9912 40cl:9913 ......... 8760
Conserve ....... Sardine - L:8760 L:7883 30cl:1289 40cl:9912 40cl:9913 ......... 7883
Conserve ....... Sardine - L:8760 L:7883 30cl:1289 40cl:9912 40cl:9913 ......... 1289
Conserve ....... Sardine - L:8760 L:7883 30cl:1289 40cl:9912 40cl:9913 ......... 9912
Conserve ....... Sardine - L:8760 L:7883 30cl:1289 40cl:9912 40cl:9913 ......... 9913


Pensez-vous que celà est possible ?

Merci de votre aide.
PS. Je n'ai pas réussi à faire des espaces pour simuler les collones, j'ai donc mis des ".". Désolé
A voir également:

2 réponses

eriiic Messages postés 24603 Date d'inscription   Statut Contributeur Dernière intervention   7 275
 
Bonjour,

une proposition :
Sub copieLig()
    Dim lig As Long, pos As Long, ch As String, ok As Boolean
    Application.ScreenUpdating = False
    For lig = [B65536].End(xlUp).Row To 2 Step -1
        ch = Cells(lig, 2): pos = 0: ok = False
        While InStr(pos + 1, ch, ":")
            pos = InStr(pos + 1, ch, ":")
            Cells(lig, 2).Offset(0, 1) = Mid(ch, pos + 1, 4)
                Cells(lig, 1).Resize(1, 3).Copy
                Rows(lig + 1).Insert Shift:=xlDown
                ok = True
        Wend
        If ok Then Rows(lig).EntireRow.Delete
    Next lig
    Application.ScreenUpdating = True
End Sub

http://www.cijoint.fr/cjlink.php?file=cj201108/cij9HM1Y3Y.xls
Les codes seront en sens inverse de leur apparition (plus simple). Si c'est nécessaire on complètera...

eric
2
jacktbio2 Messages postés 2 Date d'inscription   Statut Membre Dernière intervention  
 
Fantastique Eric,
C'est exactement ce dont j'avais besoin. Je te remercie énormément pour ton aide et surtout pour ta rapidité de réponse.

Merci mille fois.
0