Microsoft 365 Scinder une cellule en plusieurs...

[WEIDER]

Bonjour à tous !

J'aurais besoin d'un p'ti coup de pouce car je ne sais pas comment m'y prendre... Cela concerne le fait de scinder des datas d'une cellule en 3 cellules...
Tout est dit dans mon fichier joint.

Mille mercis à tous pour votre aide.

 

[JHA]

Bonjour à tous,

Une solution avec 3 petites formules stxt()

JHA

 

[WEIDER]

Bonjour JHA,

Cette solution peut très bien me convenir ! Merci beaucoup !
J'ai interverti les deux dernières colonnes car c'est le data de la colonne 'E', la plus à droite, qui m'intéresse le plus.

Deuxième action...

Certains chiffres, toujours dans la colonne 'E' se répètent, en doublon voir même plus.
Je souhaiterai lorsque c'est le cas, que les Lignes de ces doublons soient supprimées !
Ex: Que la ligne '16' et '17' soient supprimées.

Il faudrait que cette action soit bien dissociée de celle de scinder les datas, peut être un bouton macro à cliquer...

Est-ce possible ?

 

[JHA]

Bonjour à tous,

Désolé mais je ne connais pas le VBA, une solution par filtre

JHA

 

[JHA]

Bonjour à tous,

Un essai avec Power Query à creuser.

JHA

 

[job75]

Bonjour WEIDER, JHA,

Voyez le fichier .xlsm joint et les macros des 2 boutons :

Sub Scinder()
Dim tablo, resu(), i&, n&, x$, j%, k%
With [A5].CurrentRegion
    tablo = .Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
    If UBound(tablo) = 1 Then Exit Sub
    ReDim resu(1 To UBound(tablo) - 1, 1 To 3)
    For i = 2 To UBound(tablo)
        n = n + 1
        x = tablo(i, 2)
        j = InStr(x, " ")
        resu(n, 1) = RTrim(Left(x, j))
        k = InStr(x, ":")
        resu(n, 3) = Val(Mid(x, j + 1))
        If k > j + 1 Then
            resu(n, 2) = Mid(x, k)
            resu(n, 3) = LTrim(Mid(x, j + 1, k - j - 1))
        End If
    Next
    '---restitution---
    .Cells(2, 3).Resize(n, 3) = resu
End With
End Sub

Sub Supprimer_doublons()
Dim d As Object, tablo, nn&, n&, i&, x, j%
Scinder 'lance la macro
Set d = CreateObject("Scripting.Dictionary")
With [A5].CurrentRegion.Resize(, 5)
    tablo = .Value 'matrice, plus rapide
    nn = UBound(tablo)
    n = 1
    For i = 2 To nn
        x = tablo(i, 5)
        If Not d.exists(x) Then
            d(x) = ""
            n = n + 1
            For j = 1 To 5
                tablo(n, j) = tablo(i, j)
            Next j
        End If
    Next i
    '---restitution---
    .Resize(n, 5) = tablo
    .Rows(1).Offset(n).Resize(Rows.Count - n - .Row + 1).Delete xlUp 'RAZ en dessous
    MsgBox IIf(nn > n, nn - n, "Aucune") & " ligne" & IIf(nn - n > 1, "s", "") & " supprimée" & IIf(nn - n > 1, "s", "")
End With
End Sub

A+

 

[WEIDER]

Merci JHA et Job75 pour vos solutions !
Du coup, je pense faire un mixe des deux

Merci encore pour votre aide précieuse !

Amicalement,

WEIDER.