Séparer les chiffres

M

maurtoss

XLDnaute Nouveau
Bonjour,

J'ai un fichier de 300000 lignes extrait d'une plateforme à analyser. Je me heurte à un problème de séparation des chiffres des lettres.

Vous trouverez ci joint un exemple du tableau de départ et ce que je désire obtenir.

Merci pour votre aide.
 

Pièces jointes

  • Illustration.xlsx
    12.5 KB · Affichages: 95
  • Illustration.xlsx
    12.5 KB · Affichages: 111
  • Illustration.xlsx
    12.5 KB · Affichages: 101
Trier par date Trier par votes
JCGL

JCGL

XLDnaute Barbatruc
Re : Séparer les chiffres

Bonjour à tous,

Pourquoi ne pas utiliser la fonction Convertir dans le ruban avec séparateur / ?

A + à tous
 

Pièces jointes

  • JC Convertir Illustration.xls
    34 KB · Affichages: 86
Dernière édition:
Vote positif 0 Vote négatif
M

maurtoss

XLDnaute Nouveau
Re : Séparer les chiffres

Bonjour JCGL,

Je te remercie pour ta solution mais elle ne fonctionne pas correctement. En fait quand j'utilise la fonction convertir, elle convertit bien, sauf que au niveau du tableau obtenu, les colonnes ne sont pas rangées. Exemple visible sur la ligne 18 de ton fichier. Ce qui fait qu'au final j'ai des colonnes dont certaines cellules contiennent des chiffres et d'autres des lettres. Sur 300 000 lignes, j'en ai pour 50% comme ça.Soit elles sont décalées vers la droite et ceci sur plusieurs cellules, soit décalées à gauche comme dans l'exemple de la ligne 18.

Serait-il possible d'avoir une macro qui parcours la cellule initiale de la fin au début et à chaque fois qu'elle rencontre "/" met les chiffres qui sont avant le caractère "/" dans une autre cellule et ainsi de suite?

Merci
 
Dernière édition:
Vote positif 0 Vote négatif
JCGL

JCGL

XLDnaute Barbatruc
Re : Séparer les chiffres

Bonjour à tous,

Un autre essai pour isoler le numérique (elle doit être de l'ami Tibo... Vu la complexité...) :

=STXT(A5;MIN(SI(ESTNUM(STXT(A5;LIGNE(INDIRECT("1:"&NBCAR(A5)));1)*1)*LIGNE(INDIRECT("1:"&NBCAR(A5)))<>0;ESTNUM(STXT(A5;LIGNE(INDIRECT("1:"&NBCAR(A5)));1)*1)*LIGNE(INDIRECT("1:"&NBCAR(A5)))));MAX(ESTNUM(STXT(A5;LIGNE(INDIRECT("1:"&NBCAR(A5)));1)*1)*LIGNE(INDIRECT("1:"&NBCAR(A5))))-MIN(SI(ESTNUM(STXT(A5;LIGNE(INDIRECT("1:"&NBCAR(A5)));1)*1)*LIGNE(INDIRECT("1:"&NBCAR(A5)))<>0;ESTNUM(STXT(A5;LIGNE(INDIRECT("1:"&NBCAR(A5)));1)*1)*LIGNE(INDIRECT("1:"&NBCAR(A5)))))+1)
Cliquez pour agrandir...

Il reste à régler le problème des espaces dans ta chaîne qui génèrent %20 et qui renvoient une valeur numérique et les Textes genre MP3 et RAV4...

A+ à tous
 

Pièces jointes

  • JC Isole Numérique.xls
    40 KB · Affichages: 53
Dernière édition:
Vote positif 0 Vote négatif
PrinceCorwin

PrinceCorwin

XLDnaute Occasionnel
Re : Séparer les chiffres

Bonjour,

Est-ce qu'un script VBA pourrais faire l'affaire ?
Code: 
Sub fSplit()
 
Dim tCompte() As String
Dim tValeur(2) As Long
Dim tDonnees As String
Dim nbNumeric As Byte
Dim Cell As Range

On Error Resume Next
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
For Each Cell In Selection
    Erase tCompte
    Erase tValeur
    tCompte = Split(Cell.Value, "/")
    nbNumeric = 0
    tDonnees = ""
    For i = LBound(tCompte) + 1 To UBound(tCompte)
        dTemp = CLng(tCompte(i))
        If Err <> 0 Then
            tDonnees = tDonnees & tCompte(i) & "/"
            Err.Clear
        Else
            tValeur(nbNumeric) = CLng(tCompte(i))
            nbNumeric = nbNumeric + 1
            If nbNumeric = 2 Then Exit For
        End If
    Next i
    Range(Cell.Address).Offset(0, 1).Value = tDonnees
    If tValeur(0) <> 0 Then Range(Cell.Address).Offset(0, 2).Value = tValeur(0)
    If tValeur(1) <> 0 Then Range(Cell.Address).Offset(0, 3).Value = tValeur(1)
Next Cell

End Sub

Bonne journée
 
Vote positif 0 Vote négatif
ROGER2327

ROGER2327

XLDnaute Barbatruc
Re : Séparer les chiffres

Bonjour à tous


Une autre procédure :
VB: 
Sub tata()
Dim orig As Range, dest As Range
Dim i&, j&, k&, l&, p$, s, r(), oCel As Range
Const u = 65000 ' Peut être modifié. Ne pas dépasser 65536.
Set orig = Sheets("Feuil1").Columns(1).Resize(Rows.Count - 4).Offset(4, 0)  'Plage des données.
Set dest = Sheets("Feuil2").[A3]                                            'Première cellule de destination.
    For Each oCel In orig.Cells
        If Not IsEmpty(oCel) Then
            j = j + 1
            k = 1
            ReDim Preserve r(1 To 3, 1 To j)
            s = Split(oCel.Value, "/")
            For i = 0 To UBound(s)
                If IsNumeric(s(i)) Then
                    k = k + 1
                    r(k, j) = s(i)
                    If k = 3 Then Exit For
                Else
                    If k = 1 Then
                        If p <> "" Then p = p & "/"
                        p = p & s(i)
                    End If
                End If
            Next i
            If Right$(p, 1) <> "/" Then p = p & "/"
            r(1, j) = p
            p = ""
            If j = u Then
                dest.Resize(u, 3).Offset(l, 0).Value = WorksheetFunction.Transpose(r): Erase r
                l = l + u
                j = 0
            End If
        End If
    Next
    If j Then dest.Resize(j, 3).Offset(l, 0).Value = WorksheetFunction.Transpose(r): Erase r
End Sub


ROGER2327
#5393

Dimanche 22 Décervelage 139 (Ostension du Bâton à physique - fête Suprême Seconde)
29 Nivôse An CCXX, 5,9538h - mercure
2012-W03-4T14:17:21Z
 
Vote positif 0 Vote négatif
BOISGONTIER

BOISGONTIER

XLDnaute Barbatruc
Repose en paix
Re : Séparer les chiffres

Bonsoir,

Voir pj

Code: 
Function Num(chaine, n)
  Set obj = CreateObject("vbscript.regexp")
  obj.Global = True
  obj.Pattern = "\d{5,12}"
  Set a = obj.Execute(chaine)
  If a.Count > 0 Then Num = a(n - 1) Else Num = ""
End Function

Function debut(chaine)
  Application.Volatile
  Set obj = CreateObject("vbscript.regexp")
  obj.Pattern = "[a-zA-Z_/%20]+"
  Set a = obj.Execute(chaine)
  If a.Count > 0 Then debut = Mid(a(0), 2) Else debut = ""
End Function

Autre méthode + rapide : (0,57 sec pour 30.000 lignes)

Code: 
Sub essai2()
 n = [A65000].End(xlUp).Row
 a = [A2].Resize(n).Value
 Dim result()
 ReDim result(1 To n, 1 To 3)
 For i = LBound(a) To n
   temp = "/"
   b = Split(a(i, 1), "/")
   j = 1: témoin = True
   Do While j <= UBound(b) And témoin
     If Not IsNumeric(b(j)) Then temp = temp & b(j) & "/": j = j + 1 Else témoin = False
   Loop
   result(i, 1) = Mid(temp, 2)
   If j = UBound(b) + 1 Then result(i, 1) = Left(result(i, 1), Len(result(i, 1)) - 1)
   If j < UBound(b) Then result(i, 2) = b(j)
   If j + 1 <= UBound(b) Then result(i, 3) = b(j + 1)
 Next i
 [B2].Resize(n, 3).Value = result
End Sub

JB
 

Pièces jointes

  • Copie de Illustration.xls
    43 KB · Affichages: 61
  • Copie de Illustration2.xls
    50.5 KB · Affichages: 59
  • Decoupe2.xls
    63.5 KB · Affichages: 56
Dernière édition:
Vote positif 0 Vote négatif
pierrejean

pierrejean

XLDnaute Barbatruc
Re : Séparer les chiffres

Bonjour à tous

@ ROGER

Toujours friand de vos codes , j'ai un peu été surpris par le temps d'execution de votre code en #6
Aussi je me permets une proposition
PS: Je regarderai bien evidement les autres codes
 

Pièces jointes

  • Illustration(1)_b.xls
    61.5 KB · Affichages: 67
Vote positif 0 Vote négatif
ROGER2327

ROGER2327

XLDnaute Barbatruc
Re : Séparer les chiffres

Bonjour à tous
pierrejean à dit:
Bonjour à tous

@ ROGER

Toujours friand de vos codes , j'ai un peu été surpris par le temps d'execution de votre code en #6
Aussi je me permets une proposition
PS: Je regarderai bien evidement les autres codes
Cliquez pour agrandir...
Je suppose que votre surprise vient de la relative lenteur du code en question.
Je n'ai effectivement pas cherché la rapidité à tout prix. Je me suis donné d'autres contraintes :
  1. Éliminer d'éventuelles lignes vides.
  2. Sortir les deux premiers nombres rencontrés dans une ligne en ignorant un éventuel troisième nombre.
    (Par exemple, en cas de /toto/23/27/50, sortir 23 et 27, mais pas 50.)
  3. Bien qu'il ne se trouve pas d'exemple de ce type dans la demande, j'ai voulu aussi traiter les cas tels que /toto/23/plus/27/50.
  4. Notre ami parle de traiter 300_000 lignes. J'ai donc voulu découper le travail pour éviter de surcharger la mémoire lors du traitement.
  5. Enfin, pour parer à toute éventualité, j'ai voulu travailler avec une colonne pleine jusqu'à la dernière ligne (1_048_576).
Ceci dit, on peut optimiser en ne traitant pas une colonne entièrement pleine, en conservant les lignes vides, en ne prévoyant pas de cas particuliers pas demandés...
Si l'on est riche en mémoire rien n'empêche de travailler avec des tableaux d'un million de lignes.
(À ce propos, votre proposition est limitée à 65_535 lignes, loin des 300_000 lignes de notre ami, la fonction Transpose n'en acceptant pas davantage, même avec Excel2010 !)
Dans ces conditions, la proposition de BOISGONTIER (que je salue admirativement au passage), est de loin la plus rapide (mais ne traite pas une colonne pleine jusqu'à la dernière ligne).
Avec 1_048_571 lignes, essai2 tourne en 16 s, quand ma tata se traîne péniblement en 37s. Mais je pense que c'est au prix de l'utilisation de 5 fois plus de mémoire vive (à vérifier, car je ne suis pas très bon dans ces estimations).

Sur 65_535 lignes, votre toto tourne en 1,9s, ma tata légèrement bricolée en 2,3s, et essai2 en 1s.
Une nouvelle version tutu gourmande (tableau en une passe) tourne gentiment en 1,5s sur 65_535 lignes, et 23,5s sur 1_048_571 lignes.

Voici tata légèrement bricolée et le nouveau tutu :
VB: 
Sub tata()
Dim orig As Range, dest As Range
Dim i&, j&, k&, l&, p$, s, r(), oCel As Range
Const u = 65000 ' Peut être modifié. Ne pas dépasser 65536.
Set orig = Sheets("Feuil1").Columns(1).Resize(Rows.Count - 4).Offset(4, 0)  'Plage des données.
Set dest = Sheets("Feuil2").[A3]                                            'Première cellule de destination.
    If IsEmpty(orig.Cells(orig.Cells.Count)) Then
        Set orig = Sheets("Feuil1").Range(Cells(orig.Row, 1), Cells(Columns(orig.Column).Cells(Rows.Count, 1).End(xlUp).Row, 1))
    End If
    For Each oCel In orig.Cells
        If Not IsEmpty(oCel) Then
            j = j + 1
            k = 1
            ReDim Preserve r(1 To 3, 1 To j)
            s = Split(oCel.Value, "/")
            For i = 0 To UBound(s)
                If IsNumeric(s(i)) Then
                    k = k + 1
                    r(k, j) = s(i)
                    If k = 3 Then Exit For
                Else
                    If k = 1 Then
                        If p <> "" Then p = p & "/"
                        p = p & s(i)
                    End If
                End If
            Next i
            If Right$(p, 1) <> "/" Then p = p & "/"
            r(1, j) = p
            p = ""
            If j = u Then
                dest.Resize(u, 3).Offset(l, 0).Value = WorksheetFunction.Transpose(r): Erase r
                l = l + u
                j = 0
            End If
        End If
    Next
    If j Then dest.Resize(j, 3).Offset(l, 0).Value = WorksheetFunction.Transpose(r): Erase r
End Sub

Sub tutu()
Dim orig As Range, dest As Range
Dim i&, j&, k&, p$, s, oCel As Range
    Set orig = Sheets("Feuil1").Columns(1).Resize(Rows.Count - 4).Offset(4, 0)  'Plage des données.
    Set dest = Sheets("Feuil2").[A3]                                            'Première cellule de destination.
    If IsEmpty(orig.Cells(orig.Cells.Count)) Then
        Set orig = Sheets("Feuil1").Range(Cells(orig.Row, 1), Cells(Columns(orig.Column).Cells(Rows.Count, 1).End(xlUp).Row, 1))
    End If
    ReDim r(1 To orig.Cells.Count, 1 To 3)
    t = Timer
    For Each oCel In orig.Cells
        If Not IsEmpty(oCel) Then
            j = j + 1
            k = 1
            s = Split(oCel.Value, "/")
            For i = 0 To UBound(s)
                If IsNumeric(s(i)) Then
                    k = k + 1
                    r(j, k) = s(i)
                    If k = 3 Then Exit For
                Else
                    If k = 1 Then
                        If p <> "" Then p = p & "/"
                        p = p & s(i)
                    End If
                End If
            Next i
            If Right$(p, 1) <> "/" Then p = p & "/"
            r(j, 1) = p
            p = ""
        End If
    Next
    dest.Resize(j, 3).Value = r: Erase r
End Sub

Bonne journée !


ROGER2327
#5396

Lundi 23 Décervelage 139 (Saint Tank, animal - fête Suprême Quarte)
30 Nivôse An CCXX, 0,7962h - crible
2012-W03-5T01:54:39Z
 
Dernière édition:
Vote positif 0 Vote négatif
M

maurtoss

XLDnaute Nouveau
Re : Séparer les chiffres

Franchement MERCI MERCI MERCI!!!!
JCGL, PrinceCorwin, ROGER2327,JBOBO, BOISGONTIER, pierrejean Merci à tout un chacun de vous.
J'ai utilisé la méthode de JBOBO et le code de BOISGONTIER. Ce qui marche bien. je n'ai pas encore testé les autres.
Une fois encore merci à vous tous!!!!!!!!!!!!!!!!!!!!!!
 
Vote positif 0 Vote négatif
pierrejean

pierrejean

XLDnaute Barbatruc
Re : Séparer les chiffres

Re

@ ROGER

Je pensais bien , commençant à vous connaitre un peu , que vous aviez integré plus de cas de figure et je n'avais pas été plus loin que comparer les 4 s de tata a 0,015 s de toto avec la petite colonne proposée
A l'avenir je tournerai 7 fois ma souris autour de mon clavier avant de poster une anerie

@ maurtoss

Curieux que la solution de JBOBO te satisfasses
 
Vote positif 0 Vote négatif
ROGER2327

ROGER2327

XLDnaute Barbatruc
Re : Séparer les chiffres

Bonsoir à tous
pierrejean à dit:
Re

@ ROGER

Je pensais bien , commençant à vous connaitre un peu , que vous aviez integré plus de cas de figure et je n'avais pas été plus loin que comparer les 4 s de tata a 0,015 s de toto avec la petite colonne proposée
A l'avenir je tournerai 7 fois ma souris autour de mon clavier avant de poster une anerie

@ maurtoss

Curieux que la solution de JBOBO te satisfasses
Cliquez pour agrandir...
Il n'y a pas d'ânerie là-dedans. Je suis allé cherché des trucs qu'on ne demandait pas et dont l'utilité reste à démontrer.

Pour la deuxième remarque, je plussoie comme certains disent...​


ROGER2327
#5397

Lundi 23 Décervelage 139 (Saint Tank, animal - fête Suprême Quarte)
30 Nivôse An CCXX, 9,7650h - crible
2012-W03-5T23:26:10Z
 
Vote positif 0 Vote négatif
D

david84

XLDnaute Barbatruc
Re : Séparer les chiffres

Bonsoir à tous,
Une autre proposition RegExp pour l'extraction de la 1ère partie de la chaîne de caractères :
Code: 
Function debut(chaine)
  Application.Volatile
  Set obj = CreateObject("vbscript.regexp")
  obj.Pattern = "(?!/)[a-zA-Z_/]+(%20[a-z]+/|.*3_.*4/)?"
  Set a = obj.Execute(chaine)
  If a.Count > 0 Then debut = a(0) Else debut = ""
End Function
A+
 
Vote positif 0 Vote négatif
D

david84

XLDnaute Barbatruc
Re : Séparer les chiffres

Re
sans RegExp :
Code: 
Function debut2(c As String) As String
s = Split(c, "/")
For i = LBound(s) To UBound(s)
If IsNumeric(s(i)) Then temp = temp & "/" & s(i)
Next i
If temp = "" Then debut2 = Mid(c, 2, Len(c)) Else debut2 = Mid(c, 2, InStr(1, c, temp) - 1)
End Function
A+
 
Vote positif 0 Vote négatif

Discussions similaires

B
  • Question
Microsoft 365 Extraire tous les caractères après des chiffres
Réponses
11
Affichages
1 K
R@chid
R@chid
N
  • Question
Microsoft 365 séparer une colonne au niveau d'une série de chiffres
Réponses
4
Affichages
484
job75
job75
R
  • Question
XL 2019 Ajouter des lignes entre des valeurs
Réponses
3
Affichages
671
job75
job75
F
  • Question
XL 2019 Power query - Comment rechercher une chaine du style *(VOIR*)*
Réponses
2
Affichages
461
Flx1er
F
T
  • Question
Microsoft 365 rechercheV dans un userform avec valeur initiale en chiffres + lettres
Réponses
10
Affichages
782
thibz_99
T
T
  • Question
XL 2010 Additonner des chiffres d'un export web
Réponses
2
Affichages
581
Tigerfred
T
A
  • Question
XL 2010 RECHERCHE OCCURRENCE DE 3 CHIFFRES PARMI UN ENSEMBLE DE NOMBRE /RÉSULTAT CROISSANT
Réponses
5
Affichages
724
aeroberto0099
A
V
  • Question
XL 2019 INDEX et EQUIV avec cellules Lettres & Nombres
Réponses
8
Affichages
1 K
Valer5555
V
C
  • Résolu(e)
Autres Excel 2007 VBA séparer colonne et ligne obtenues avec .adress
Réponses
9
Affichages
559
CR16
C
A
  • Question
XL 2019 Recherche d'occurence de 3 chiffres ou triplons sur un tableau de nombres avec mise en avant dans un tableau annex
Réponses
13
Affichages
889
labombola46
L

Membres actuellement en ligne

5 membres et 58 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
312 685
Messages
2 090 946
Membres
104 705
dernier inscrit
Mike72