Pb SPLIT avec deux séparateurs ( array ("+", "-")

zebanx

zebanx

XLDnaute Accro
Bonjour à tous,

Je cherche à spliter sur plusieurs colonnes certaines cellules liées.
Un code me permet de le faire en utilisant SPLIT avec comme séparateur "+".

Mais je souhaite utiliser un deuxième séparateur "-" dans le tableau.
Tentative avec un array mais ça ne fonctionne pas du tout.

Un classeur d'accompagnement reprend plus clairement le besoin. Attention, il faut sélectionner la zone avant de lancer la macro.

Pourriez-vous m'aider svp à corriger le code initial (séparateur uniquement "+") suivant :

Code: 
Sub splitSelection_plus()
Dim k As Integer
Dim selR As Range

Set selR = Selection
With Selection
lignedeb = .Row
colref = .Column
lignefin = lignedeb + .Rows.Count - 1
End With

separ = "+"

On Error Resume Next
For k = lignedeb To lignefin + 1
    For l = 0 To 9
        If Mid(Cells(k, colref), 2, 1) = separ Then
        Cells(k, colref).Offset(0, l + 1).Formula = "=" & Split(Cells(k, colref), separ)(l + 1) '---va chercher valeur
        Else
        Cells(k, colref).Offset(0, l + 1).Formula = IIf(l = 0, Split(Cells(k, colref), separ)(l), "=" & Split(Cells(k, colref), separ)(l))
       End If
     Next l
Next k

End Sub

Je vous en remercie
zebanx
 

Pièces jointes

  • classeur_split.xls
    35.5 KB · Affichages: 21
Trier par date Trier par votes
zebanx

zebanx

XLDnaute Accro
Je crois avoir pu contourné le problème en remplaçant le "-" par un "+-" qui permet de n'utiliser qu'un caractère. Bien pratique.
Un "-", c'est un "+-" qui s'ignore.

Désolé pour le dérangement, bonne journée
++

Code: 
Sub splitSelection_plus_moins()
Dim k As Integer
Dim selR As Range

Set selR = Selection
separ = "+"
With Selection
lignedeb = .Row: colref = .Column: lignefin = lignedeb + .Rows.Count - 1
.replace What:="-", Replacement:="+-", LookAt:=xlPart, SearchOrder:=xlByRows
End With

On Error Resume Next
For k = lignedeb To lignefin + 1
    For l = 0 To 9
        If Mid(Cells(k, colref), 2, 1) = separ Then
        Cells(k, colref).Offset(0, l + 1).Formula = "=" & Split(Cells(k, colref), separ)(l + 1) '---va chercher valeur
        Else
        Cells(k, colref).Offset(0, l + 1).Formula = IIf(l = 0, Split(Cells(k, colref), separ)(l), "=" & Split(Cells(k, colref), separ)(l))
       End If
     Next l
Next k

End Sub
 
Vote positif 0 Vote négatif
BOISGONTIER

BOISGONTIER

XLDnaute Barbatruc
Repose en paix
Bonjour,

Une fonction SplitPlusMoins(chaine) ??

Code: 
Sub Essai2()
  chaine = "aa+bb-cc+dd"
  Tbl = SplitPlusMoins(chaine)
  [A1].Resize(UBound(Tbl) + 1) = Application.Transpose(Tbl)
End Sub

Function SplitPlusMoins(chaine)
  SplitPlusMoins = Split(Replace(chaine, "-", "+"), "+")
End Function

Boisgontier
 
Vote positif 0 Vote négatif
Dranreb

Dranreb

XLDnaute Barbatruc
Bonjour.
Comme ça ça a l'air pas mal :
VB: 
Sub SplitPlusMoins()
Dim TE(), L&, TS(), C&, Ts1$(), P1&, Ts2$(), P2&
TE = Selection.Value
ReDim TS(1 To UBound(TE, 1), 1 To 6)
For L = 1 To UBound(TE, 1)
   C = 0: Ts1 = Split(Mid$(TE(L, 1), 2), "+")
   For P1 = 0 To UBound(Ts1)
      Ts2 = Split(Ts1(P1), "-"): If UBound(Ts2) < 0 Then ReDim Ts2(0 To 0)
      C = C + 1: If Ts2(0) <> "" Then TS(L, C) = "=" & Ts2(0)
      For P2 = 1 To UBound(Ts2)
         C = C + 1: If Ts2(P2) <> "" Then TS(L, C) = "=-" & Ts2(P2)
         Next P2, P1, L
Selection.Columns(2).Resize(, 6).Value = TS
End Sub
 
Vote positif 0 Vote négatif
Dranreb

Dranreb

XLDnaute Barbatruc
Ou plutôt comme ça, si un "+" au début ni des séries de séparateurs consécutifs n'ont de signification :
VB: 
Sub SplitPlusMoins()
Dim TE(), L&, TS(), C&, Ts1$(), P1&, Ts2$(), P2&
TE = Selection.Value
ReDim TS(1 To UBound(TE, 1), 1 To 6)
For L = 1 To UBound(TE, 1)
   C = 0: Ts1 = Split(Mid$(TE(L, 1), 2), "+")
   For P1 = 0 To UBound(Ts1)
      Ts2 = Split(Ts1(P1), "-"): If UBound(Ts2) < 0 Then ReDim Ts2(0 To 0)
      If Ts2(0) <> "" Then C = C + 1: TS(L, C) = "=" & Ts2(0)
      For P2 = 1 To UBound(Ts2)
         If Ts2(P2) <> "" Then C = C + 1: TS(L, C) = "=-" & Ts2(P2)
         Next P2, P1, L
Selection.Columns(2).Resize(, 6).Value = TS
End Sub
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bonjour zebanx, JB, Bernard,
Code: 
Sub split_plus_moins()
Dim c As Range, s, n%, i%, x As Variant
Application.ScreenUpdating = False
With Feuil1.[A1].CurrentRegion.Columns(1)
    .Offset(, 1).Resize(, .Parent.Columns.Count - 1).ClearContents 'RAZ
    For Each c In .Cells
        s = Split(Replace(c, "-", "+-"), "+")
        n = 1
        For i = 0 To UBound(s)
            x = Evaluate(s(i))
            If Not IsError(x) Then
                n = n + 1
                c(1, n) = x
            End If
    Next i, c
End With
End Sub
S'il y a beaucoup de lignes il faudra utiliser des tableaux VBA.

A+
 

Pièces jointes

  • classeur_split(1).xls
    81 KB · Affichages: 19
Vote positif 0 Vote négatif
zebanx

zebanx

XLDnaute Accro
Bonjour et merci à tous pour vos réponses.

Je dois préciser que l'utilité est double, ce qui aurait dû être indiqué dès le départ :

1- Éclater pour ce qu'on appelle une "piste d'audit" une formule utilisée dans un tableau avec ses différentes composantes

2- Prévoir automatiquement un lien hypertexte (sujet de cette fin de semaine..).
Pour le point 2, la deuxième solution de Dranreb me convient peut-être la mieux car elle préserve les formules.

Le travail est fait et je vous en remercie.

Et pour les syntaxes, l'utilisation des différentes méthodes reste vraiment très intéressante, comme d'habitude. ;)

Bon apm
zebanx
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re,
job75 à dit:
S'il y a beaucoup de lignes il faudra utiliser des tableaux VBA.
Cliquez pour agrandir...
Sur 10 000 lignes cette macro s'exécute chez moi en 9,5 secondes :
Code: 
Sub split_plus_moins()
Dim t, tablo, i&, s, n%, j%, x As Variant, ncol%, resu()
t = Timer
With Feuil1.[A1].CurrentRegion.Columns(1)
    tablo = .Resize(.Rows.Count + 1) 'matrice, plus rapide, au moins 2 éléments
    For i = 2 To UBound(tablo) - 1
        s = Split(Replace(tablo(i, 1), "-", "+-"), "+")
        n = 0
        For j = 0 To UBound(s)
            x = Evaluate(s(j))
            If Not IsError(x) Then
                n = n + 1
                If n > ncol Then ncol = n: ReDim Preserve resu(1 To UBound(tablo), 1 To n)
                resu(i, n) = x
            End If
    Next j, i
    If .Parent.FilterMode Then .Parent.ShowAllData 'si la feuille est filtrée
    .Offset(, 1).Resize(, ncol) = resu
    .Offset(, ncol + 1).Resize(, .Parent.Columns.Count - ncol - 1).ClearContents 'RAZ à droite
End With
MsgBox "Durée " & Format(Timer - t, "0.00 \s")
End Sub
Fichier (2).

A+
 

Pièces jointes

  • classeur_split(2).xls
    1 MB · Affichages: 20
Vote positif 0 Vote négatif
zebanx

zebanx

XLDnaute Accro
Merci à Job75

En rajoutant un application.calculation, ta macro s'exécute plus rapidement en 4 secondes
Avec la macro en 2, on tourne autour des 6 secondes mais elle modifie la colonne 1 "remplacement de "-" par "+-" ce qui pose problème pour une relance de la macro).
Mais celle de Dranreb en #5 tourne en moins de 1 seconde.:eek:
Je zippe le tout, trop lourd.
Par contre, il faut toujours sélectionner les zones avec les macros ...zebanx ou ....dranreb à ce stade (mais ça je l'avais pas demandé..)

@+


Code: 
Sub split_plus_moins()
Dim t, tablo, i&, s, n%, j%, x As Variant, ncol%, resu()
t = Timer
Application.Calculation = xlManual
With Feuil1.[A1].CurrentRegion.Columns(1)
    tablo = .Resize(.Rows.Count + 1) 'matrice, plus rapide, au moins 2 éléments
    For i = 2 To UBound(tablo) - 1
        s = Split(Replace(tablo(i, 1), "-", "+-"), "+")
        n = 0
        For j = 0 To UBound(s)
            x = Evaluate(s(j))
            If Not IsError(x) Then
                n = n + 1
                If n > ncol Then ncol = n: ReDim Preserve resu(1 To UBound(tablo), 1 To n)
                resu(i, n) = x
            End If
    Next j, i
    If .Parent.FilterMode Then .Parent.ShowAllData 'si la feuille est filtrée
    .Offset(, 1).Resize(, ncol) = resu
    .Offset(, ncol + 1).Resize(, .Parent.Columns.Count - ncol - 1).ClearContents 'RAZ à droite
End With
Application.Calculation = xlAutomatic
MsgBox "Durée " & Format(Timer - t, "0.00 \s")
End Sub
 

Pièces jointes

  • split_classeur_job75.zip
    462.6 KB · Affichages: 13
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re,
zebanx à dit:
2- Prévoir automatiquement un lien hypertexte (sujet de cette fin de semaine..).
Cliquez pour agrandir...
Chez moi sur 10 000 lignes les liens hypertextes sont créés en 24 secondes :
Code: 
Sub split_plus_moins()
Dim t, c As Range, s, n%, i%, x$, e As Variant
t = Timer
Application.ScreenUpdating = False
With Feuil1.[A1].CurrentRegion.Columns(1)
    .Offset(, 1).Resize(, .Parent.Columns.Count - 1).Delete xlToLeft 'RAZ
    For Each c In .Cells
        s = Split(Replace(Replace(c.Formula, "=", ""), "-", "+-"), "+")
        n = 1
        For i = 0 To UBound(s)
            x = s(i): e = Evaluate(x)
            If Not IsError(e) Then
                n = n + 1
                c(1, n).Hyperlinks.Add c(1, n), "", "#" & Replace(x, "-", ""), TextToDisplay:=CStr(e)
            End If
    Next i, c
End With
Application.ScreenUpdating = True
MsgBox "Durée " & Format(Timer - t, "0.00 \s")
End Sub
Fichier (3).

A+
 

Pièces jointes

  • classeur_split(3).xls
    784.5 KB · Affichages: 17
Vote positif 0 Vote négatif
zebanx

zebanx

XLDnaute Accro
Très très beau travail, merci JOB75 :)

Le temps me convient très bien et ton extraction permet de lier les nombres négatifs à la cellule liée, c'est super.
Ca fait un très joli code pour quelqu'un qui doit utiliser des nombreux liens pour aller directement à sa source. Et il n'y a surement pas 10000 lignes donc ton code va aller impeccable.
Sur 1000 lignes, moins d'une seconde, c'est déjà une bonne base !

Serait-il possible cependant STP d'avoir un autre code permettant d'afficher dans la barre de formule, pour chaque cellule "splitée", la cellule liée ?
---> si c'est trop long à faire, ne le fait pas, y a pas de problème, c'est déjà beaucoup !

Et quand tu auras le temps stp, pourrais-tu me donner quelques précisions sur les parties en "rouge" :
- s = Split(Replace(Replace(c.Formula, "=", ""), "-", "+-"), "+")
- c(1, n).Hyperlinks.Add c(1, n), "", "#" & Replace(x, "-", ""), TextToDisplay:=CStr(e)

Je te remerie vivement pour ce post et te souhaite une bonne soirée
zebanx
 
Dernière édition:
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re,
zebanx à dit:
Serait-il possible cependant STP d'avoir un autre code permettant d'afficher dans la barre de formule, pour chaque cellule "splitée", la cellule liée ?
Cliquez pour agrandir...
Fichier (4) avec cette macro :
Code: 
Sub split_plus_moins()
Dim t, c As Range, s, n%, i%, x$, e As Variant
t = Timer
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
With Feuil1.[A1].CurrentRegion.Columns(1)
    .Offset(, 1).Resize(, .Parent.Columns.Count - 1).Delete xlToLeft 'RAZ
    For Each c In .Cells
        s = Split(Replace(Replace(c.Formula, "=", ""), "-", "+-"), "+")
        n = 1
        For i = 0 To UBound(s)
            x = s(i): e = Evaluate(x)
            If Not IsError(e) Then
                n = n + 1
                c(1, n) = "=" & x
                c(1, n).Hyperlinks.Add c(1, n), "", "#" & Replace(x, "-", "")
            End If
    Next i, c
End With
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
MsgBox "Durée " & Format(Timer - t, "0.00 \s")
End Sub
Chez moi, grâce aux Application.Calculation, la durée d'exécution augmente peu => 26 secondes.

A+
 

Pièces jointes

  • classeur_split(4).xls
    784.5 KB · Affichages: 18
Vote positif 0 Vote négatif

Discussions similaires

cathodique
  • Question
XL 2010 Comment lire array dans item dictionnaire
2 3
Réponses
33
Affichages
2 K
cathodique
cathodique
N
  • Résolu(e)
Microsoft 365 Code fonction pour création code aléatoire
2 3
Réponses
32
Affichages
494
NONO14
N
R
  • Question
XL 2019 Demande à la macro de chercher et de remplir automatiquement jusqu'à la dernière valeur
Réponses
1
Affichages
401
Aya_flo
A
R
  • Question
XL 2019 Transpose et limiter nombre de valeur
Réponses
1
Affichages
258
Rabeto
R
C
  • Question
XL 2021 Problème de remplissage d'une colonne conditionné à d'autres valeurs
Réponses
2
Affichages
310
CathyLD
C
lynyrd
  • Question
XL 2019 code pour tous les disques
Réponses
3
Affichages
471
AtTheOne
AtTheOne
Nicolas JACQUIN
  • Question
XL 2021 Exportation feuille msgbox yes no avec module Thisworkbook
2
Réponses
21
Affichages
880
Nicolas JACQUIN
Nicolas JACQUIN
R
  • Question
XL 2016 excel 2016 VBA
Réponses
2
Affichages
303
rebatte
R
A
  • Question
Insérer un copier / coller
Réponses
0
Affichages
271
aziz
A
L
  • Question
VBA : erreur sur boucle
Réponses
2
Affichages
248
Latias
L

Membres actuellement en ligne

9 membres et 69 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
314 628
Messages
2 111 337
Membres
111 104
dernier inscrit
JEMADA