VBA Excel - Copier des lignes si condition [Résolu/Fermé]

Signaler
Messages postés
2
Date d'inscription
mercredi 17 août 2011
Statut
Membre
Dernière intervention
17 août 2011
-
Messages postés
2
Date d'inscription
mercredi 17 août 2011
Statut
Membre
Dernière intervention
17 août 2011
-
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é

2 réponses

Messages postés
23813
Date d'inscription
mardi 11 septembre 2007
Statut
Contributeur
Dernière intervention
24 janvier 2021
6 590
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
Merci

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

CCM 63550 internautes nous ont dit merci ce mois-ci

Messages postés
2
Date d'inscription
mercredi 17 août 2011
Statut
Membre
Dernière intervention
17 août 2011

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.