Autres 'Resolu' 'Nettoyer' des lignes par une macro

klorane

XLDnaute Occasionnel
Bonjour à tous,

j'ai une feuille excel avec en colonne B un nom de produit 'produit1' par exemple suivi de ':' et derrière des références séparées par des '-'
suivi d'un saut de ligne etc. (voir le fichier tabl1)

je recherche par le biais d'une macro en cliquant sur un bouton à organiser les différents lignes de la colonne B pour en faire un tableau voir le fichier tabl2.

Quelqu'un saurait il faire ceci?

Info: La liste en colonne B peut être plus ou moins longue (aller par exemple jusqu'à B150 ou des fois B130...) . Eventuellement que je puisse préciser dans la macro jusqu'à quelle ligne elle doit effectuer le tri.

Je suis sur excel 2007.

Merci de votre aide

Cordialement,
Klorane
 

Pièces jointes

  • tabl1.xlsm
    8.8 KB · Affichages: 3
  • tabl2.xlsm
    14.8 KB · Affichages: 3

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Klorane,
Un essai en PJ avec :
VB:
Sub Bouton1_Clic()
Dim DL%, L%, i%, j%, Tablo, T, Tsplit1, Tsplit2
DL = [B10000].End(xlUp).Row                     ' Dernière ligne ou mettre la dernière ligne désirée
Tablo = Range("B1:B" & DL)                      ' Plage dans array
ReDim T(1 To UBound(Tablo), 1 To 100)           ' T : array de sortie
L = 1                                           ' Init 1ere ligne écriture en sortie
For i = 1 To UBound(Tablo)
    If Tablo(i, 1) <> "" Then
        If Tablo(i, 1) Like "*:*" And Tablo(i, 1) Like "*-*" Then ' La chaine doit contenir ":" et "-"
            Tsplit1 = Split(Tablo(i, 1), ":")   ' Découpage avec séparateur ":"
            T(L, 1) = Tsplit1(0)                ' rangement du produit
            Tsplit2 = Split(Tsplit1(1), " - ")  ' Découpage avec séparateur " - "
            For j = 0 To UBound(Tsplit2)        ' Rangement des nombres
                T(L, j + 2) = Tsplit2(j)
            Next j
            L = L + 1                           ' Prochaine ligne
        End If
    End If
Next i
'Restitution
[D:ZZ].ClearContents
Application.ScreenUpdating = False
[D3].Resize(UBound(T, 1), UBound(T, 2)) = T     ' Array de sortie dans cellules
End Sub
 

Pièces jointes

  • tabl2.xlsm
    18.3 KB · Affichages: 3

job75

XLDnaute Barbatruc
Bonjour klorane, sylvanu,
VB:
Sub Eclater()
[D:D].Resize(, Columns.Count - 3).Delete 'RAZ
With [D2:D1000]
    [B2:B1000].Copy .Cells(1) 'copier-coller
    .Replace " ", "", xlPart
    .Replace ":", "-"
    .TextToColumns .Cells(1), xlDelimited, Other:=True, OtherChar:="-" 'commande Convertir
    .Resize(, Columns.Count - 3).Columns.AutoFit 'ajustement largeurs
End With
End Sub
A+
 

Pièces jointes

  • Eclater.xlsm
    20.8 KB · Affichages: 5

klorane

XLDnaute Occasionnel
Bonsoir Job75,

merci pour ton code.

Je l'ai essayé et j'ai un soucis avec.

il fonctionne MAIS la valeur copiée dans la cellule n'est pas 'validée'... comme si la cellule était vide.

si je lui demande par exemple de comparer la valeur de la cellule E2 avec une valeur située ailleurs mais égale à E2 et de m'afficher un 1 il me dit 0 alors qu'il devrait me donner 1.

Si je retape la meme valeur dans E2 au clavier il me donne 1.

il manque je pense un truc genre range.....et value dans la copie qui permet de bien recopier la valeur numérique.

Klorane
 
Dernière édition:

job75

XLDnaute Barbatruc
D'accord, il suffit de supprimer les caractères de code 160 :
VB:
Sub Eclater()
[D:D].Resize(, Columns.Count - 3).Delete 'RAZ
With [D2:D1000]
    [B2:B1000].Copy .Cells(1) 'copier-coller
    .Replace Chr(160), "", xlPart
    .Replace " ", ""
    .Replace ":", "-"
    .TextToColumns .Cells(1), xlDelimited, Other:=True, OtherChar:="-" 'commande Convertir
    .Resize(, Columns.Count - 3).Columns.AutoFit 'ajustement largeurs
End With
End Sub
 

Pièces jointes

  • Eclater(1).xlsm
    20.9 KB · Affichages: 1

Discussions similaires

Statistiques des forums

Discussions
313 205
Messages
2 096 210
Membres
106 533
dernier inscrit
chavrotti