Convertir cellule excel en ajoutant une nouvelle ligne no 2 Macro

A

avyrex1626

XLDnaute Nouveau
Bonjour,
Je reviens avec ce forum car je me retrouve avec un autre problème.
Avec ce code, il sépare les pos des noms inscrient dans la colonne L.

Code: 
Sub conversion()
Application.ScreenUpdating = False
For n = 4 To Range("L" & Rows.Count).End(xlUp).Row
While InStr(Range("L" & n), "-") <> 0
 Range("M" & n) = Range("M" & n) & ";" & Mid(Range("L" & n), InStr(Range("L" & n), "-") - 6, 9)
 Range("L" & n) = Replace(Range("L" & n), Mid(Range("L" & n), InStr(Range("L" & n), "-") - 6, 9), "")
Wend
Next n
For n = Range("L" & Rows.Count).End(xlUp).Row To 4 Step -1
 x = Split(Range("M" & n), ";")
 If UBound(x) > -1 Then
  Range("M" & n) = x(1)
  Range("L" & n) = Replace(Range("L" & n), ",", "")
 For m = 2 To UBound(x)
  Rows(n).Insert
  Range("M" & n) = x(m)
  Range("A" & n + 1 & ":L" & n + 1).Copy Destination:=Range("A" & n)
 Next m
 End If
Next n
Application.ScreenUpdating = True
End Sub
Mon problème maintenant est que la macro prend en considération le "-" afin de repérer les Pos.
Mais il y arrive qu'un nom possède aussi un "-". Quand ça arrive, il prend une partie du nom comme un numéro de PO.
Comment je peux corriger ça pour qu'il sépare les pos qui auraient par exemple le format qui se termine par "-00"
Les pos auront toujours 2 numéros après le "-". Jamais les noms.
Merci encore pour votre aide.
 

Pièces jointes

  • avant.jpg
    avant.jpg
    100.2 KB · Affichages: 68
  • Copie de Test-convert-name-r2.xlsm
    24.6 KB · Affichages: 53
  • Apres.jpg
    Apres.jpg
    53.4 KB · Affichages: 76
  • avant.jpg
    avant.jpg
    100.2 KB · Affichages: 73
  • Copie de Test-convert-name-r2.xlsm
    24.6 KB · Affichages: 55
  • Apres.jpg
    Apres.jpg
    53.4 KB · Affichages: 72
  • avant.jpg
    avant.jpg
    100.2 KB · Affichages: 74
  • Copie de Test-convert-name-r2.xlsm
    24.6 KB · Affichages: 55
  • Apres.jpg
    Apres.jpg
    53.4 KB · Affichages: 77
Trier par date Trier par votes
Papou-net

Papou-net

XLDnaute Barbatruc
Re : Convertir cellule excel en ajoutant une nouvelle ligne no 2 Macro

Bonsoir avyrex1626,

Vois si ta macro modifiée te convient à l'usage :

Code: 
Sub conversion()
Application.ScreenUpdating = False
For n = 4 To Range("L" & Rows.Count).End(xlUp).Row
  nom = Range("L" & n).Value
  i = InStr(nom, "-")
  While i > 0
    If IsNumeric(Mid(nom, i - 7, 6)) And IsNumeric(Mid(nom, i + 1, 2)) Then
      Range("M" & n) = Range("M" & n) & ";" & Mid(nom, i - 6, 9)
      Range("L" & n) = Replace(Range("L" & n), Mid(Range("L" & n), InStr(Range("L" & n), "-") - 6, 9), "")
    End If
    nom = Mid(nom, i + 1)
    i = InStr(nom, "-")
  Wend
Next n
For n = Range("L" & Rows.Count).End(xlUp).Row To 4 Step -1
  x = Split(Range("M" & n), ";")
  If UBound(x) > -1 Then
    Range("M" & n) = x(1)
    Range("L" & n) = Replace(Range("L" & n), ",", "")
    For m = 2 To UBound(x)
      Rows(n).Insert
      Range("M" & n) = x(m)
      Range("A" & n + 1 & ":L" & n + 1).Copy Destination:=Range("A" & n)
    Next m
  End If
Next n
Application.ScreenUpdating = True
End Sub
En te souhaitant une bonne nuit.

Cordialement
 
Vote positif 0 Vote négatif
A

avyrex1626

XLDnaute Nouveau
Re : Convertir cellule excel en ajoutant une nouvelle ligne no 2 Macro

Bonjou Popou-net,
Nous y sommes pret
Il n'a pas transféré les noms avec un "-".
Par contre, le premier des numéros est resté dans la colonne des noms même s'il apparaît dans la colonne de PO.

De plus, il a même modifié le nom:

Au lieu de garder le nom: CARGILL FOODS - TRILLIUM
Il a écrit: CARGILL RILLIUM



Merci encore pour ton aide
 

Pièces jointes

  • Resultat.jpg
    Resultat.jpg
    46.9 KB · Affichages: 74
  • Resultat.jpg
    Resultat.jpg
    46.9 KB · Affichages: 72
  • Resultat.jpg
    Resultat.jpg
    46.9 KB · Affichages: 68
Dernière édition:
Vote positif 0 Vote négatif
Papou-net

Papou-net

XLDnaute Barbatruc
Re : Convertir cellule excel en ajoutant une nouvelle ligne no 2 Macro

Bonjour avyrex1626,

Voici ton fichier modifié

Il me paraît fonctionner comme tu le souhaites, mais je te laisse le soin de le tester.

Voici les détails de la macro :

Code: 
Sub conversion()
Dim Nom As String, Lib As String, Po As String

Application.ScreenUpdating = False
For n = 4 To Range("L" & Rows.Count).End(xlUp).Row
  Nom = Range("L" & n).Value
  Lib = Nom
  i = InStr(Lib, "-")
  While i > 0
    If IsNumeric(Mid(Lib, i - 7, 6)) And IsNumeric(Mid(Lib, i + 1, 2)) Then
      Po = Mid(Lib, i - 6, 9)
      Range("M" & n) = Range("M" & n) & ";" & Po
    End If
    Lib = Mid(Lib, i + 1)
    i = InStr(Lib, "-")
  Wend
  Range("M" & n) = Mid(Range("M" & n), 2)
Next n
For n = Range("L" & Rows.Count).End(xlUp).Row To 4 Step -1
  Range("L" & n) = Replace(Range("L" & n), Replace(Range("M" & n), ";", ", "), "")
  x = Split(Range("M" & n), ";")
  If UBound(x) > 0 Then
    Range("M" & n) = x(UBound(x))
    For m = UBound(x) - 1 To 0 Step -1
      Rows(n).Insert
      Range("M" & n) = x(m)
      Range("A" & n + 1 & ":L" & n + 1).Copy Destination:=Range("A" & n)
    Next m
  End If
Next n
Application.ScreenUpdating = True
End Sub
Espérant avoir résolu les bugs.

Bon WE.

Cordialement.
 

Pièces jointes

  • Copie 01 de Test-convert-name-r2-1.xlsm
    28.8 KB · Affichages: 48
Vote positif 0 Vote négatif
A

avyrex1626

XLDnaute Nouveau
Re : Convertir cellule excel en ajoutant une nouvelle ligne no 2 Macro

Bonjour,

Désolé pour le retard, je fesais des test et je suis tombé sur un probleme.

Ex: Comme nom dans la colonne L, j'ai COTT-VISCOUNT-9034682 948180-03


Le nom est COTT-VISCOUNT-9034682 et le PO est 948180-03

lorsque j'active la macro, j'ai un erreur d'exécution 5, Argument ou appel de procédure incorrect.

Est-ce que tu sais pourquoi et comment je peux régler le problème?

Merci encore pour ton aide.
 

Pièces jointes

  • Copie 01 de Test-convert-name-r2-3.xlsm
    26 KB · Affichages: 43
Dernière édition:
Vote positif 0 Vote négatif
Papou-net

Papou-net

XLDnaute Barbatruc
Re : Convertir cellule excel en ajoutant une nouvelle ligne no 2 Macro

Bonsoir avyrex1626,

Voici qui est réparé

J'ai ajouté une condition de test (If i > 7) Then) :

Code: 
Sub conversion()
Dim Nom As String, Lib As String, Po As String

Application.ScreenUpdating = False
For n = 4 To Range("L" & Rows.Count).End(xlUp).Row
  Nom = Range("L" & n).Value
  Lib = Nom
  i = InStr(Lib, "-")
  While i > 0
    If i > 7 Then
      If IsNumeric(Mid(Lib, i - 7, 6)) And IsNumeric(Mid(Lib, i + 1, 2)) Then
        Po = Mid(Lib, i - 6, 9)
        Range("M" & n) = Range("M" & n) & ";" & Po
      End If
    End If
    Lib = Mid(Lib, i + 1)
    i = InStr(Lib, "-")
  Wend
  Range("M" & n) = Mid(Range("M" & n), 2)
Next n
For n = Range("L" & Rows.Count).End(xlUp).Row To 4 Step -1
  Range("L" & n) = Replace(Range("L" & n), Replace(Range("M" & n), ";", ", "), "")
  x = Split(Range("M" & n), ";")
  If UBound(x) > 0 Then
    Range("M" & n) = x(UBound(x))
'    Range("L" & n) = Replace(Range("L" & n), x(0), "")
    For m = UBound(x) - 1 To 0 Step -1
      Rows(n).Insert
      Range("M" & n) = x(m)
      Range("A" & n + 1 & ":L" & n + 1).Copy Destination:=Range("A" & n)
    Next m
  End If
Next n
Application.ScreenUpdating = True
End Sub

En te souhaitant une bonne soirée.

Cordialement.
 

Pièces jointes

  • Copie 02 de Test-convert-name-r2-3.xlsm
    28.9 KB · Affichages: 41
Vote positif 0 Vote négatif

Discussions similaires

R
  • Question
XL 2016 excel 2016 VBA
Réponses
2
Affichages
150
rebatte
R
R
  • Question
XL 2021 Optimisation Code VBA
Réponses
10
Affichages
364
Dranreb
Dranreb
halecs93
  • Résolu(e)
XL 2016 Indice n'appartient pas à la sélection : HELP !!!!
2
Réponses
21
Affichages
526
halecs93
halecs93
L
  • Question
VBA : erreur sur boucle
Réponses
2
Affichages
63
Latias
L
pompaero
  • Résolu(e)
Microsoft 365 Amélioration codage
Réponses
4
Affichages
194
pompaero
pompaero
M
  • Question
Microsoft 365 Macro VBA supprimer une colonne
Réponses
5
Affichages
89
marie3107
M
A
  • Question
Insérer un copier / coller
Réponses
0
Affichages
170
aziz
A
C
  • Résolu(e)
Microsoft 365 Amélioration Macro.
Réponses
7
Affichages
312
crazy
C
E
  • Question
XL 2013 vba excel
Réponses
6
Affichages
228
sylvanu
sylvanu
R
  • Résolu(e)
XL 2016 extraire des données
Réponses
2
Affichages
493
rebatte
R

Membres actuellement en ligne

4 membres et 50 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 106
Messages
2 085 352
Membres
102 871
dernier inscrit
Maïmanko