VBA Excel - Copier des lignes si condition
Résolu
jacktbio2
Messages postés
2
Statut
Membre
-
jacktbio2 Messages postés 2 Statut Membre -
jacktbio2 Messages postés 2 Statut Membre -
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é
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
-
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 -
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.
