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

[klorane]

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

 

[sylvanu]

Bonjour Klorane,
Un essai en PJ avec :

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

 

[klorane]

Bonjour Sylanu et un grand merci pour le coup de main!!!

C'est tout à fait ça!!!

Bonne journée et encore merci

Klorane

 

[job75]

Bonjour klorane, sylvanu,

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+

 

[klorane]

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

 

[sylvanu]

Bonsoir Klorane, Job,
Tous les nombres de la colonnes E commence par le caractère code 160.
Il s'agit donc de texte non de nombres.

 

[job75]

D'accord, il suffit de supprimer les caractères de code 160 :

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

 

[klorane]

Bonsoir Sylvanu, Job,

avec la modification c'est parfait.

Merci encore à vous 2 pour votre aide

Au plaisir

Klorane