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

  • Initiateur de la discussion Initiateur de la discussion klorane
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

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

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

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

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:
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

- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Retour