XL 2016 extraction de données

M

marc.gilliand

XLDnaute Occasionnel
Bonjour le forum,
1er exemple : j'ai une cellule qui contient la donnée suivante
Frisco Extrême Citron&Limes SL 16x145ml
je souhaite extraire dans deux colonnes séparées la valeur 16 et la valeur 145
2ème exemple :
Nuii MP WhiteChocolCranber 8x(4x90ml)
je souhaite extraire dans 3 colonnes séparées la valeur 8, la valeur 4 et la valeur 90

Merci de votre aide.
 
Solution
job75
Bonjour marc.gilliand, JM,

Voyez le fichier joint et la macro affecté au bouton :
VB: 
Sub Extraire()
Dim tablo, i&, x$, j%, y$
Application.ScreenUpdating = False
Columns("B").Resize(, Columns.Count - 1).Delete 'RAZ
tablo = [A1].CurrentRegion.Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
For i = 1 To UBound(tablo)
    x = tablo(i, 1)
    For j = 1 To Len(x)
        y = Mid(x, j, 1)
        If y <> " " Then If Not IsNumeric(y) Then x = Replace(x, y, " ")
    Next j
    tablo(i, 1) = Application.Trim(x) 'SUPPRESPACE
Next i
'---restitution---
With [B1].Resize(i - 1)
    .Value = tablo
    .TextToColumns .Cells, xlDelimited, Space:=True 'commande Convertir
End With
End Sub
A+
Trier par date Trier par votes
Staple1600

Staple1600

XLDnaute Barbatruc
Bonjour le fil, marc.gilliand

Pourquoi tu ne réutilises pas la formule que je t'ai proposée dans une autre de tes discussions ?
www.excel-downloads.com

XL 2016 - extraction de charactères

Bonjour le forum, J'ai en colonne A : 8 cts x 13 Lagen = 104 cts = 520 kg / p 8 cts x 13 Lagen = 104 cts = 520 kg / p 12 cts x 8 Lagen = 96 cts = 480 kg / p je souhaiterai dans la colonne B extraire le "8", J'utilise la fonction gauche Mais de plus je souhaiterai extraire dans la...
www.excel-downloads.com www.excel-downloads.com
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bonjour marc.gilliand, JM,

Voyez le fichier joint et la macro affecté au bouton :
VB: 
Sub Extraire()
Dim tablo, i&, x$, j%, y$
Application.ScreenUpdating = False
Columns("B").Resize(, Columns.Count - 1).Delete 'RAZ
tablo = [A1].CurrentRegion.Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
For i = 1 To UBound(tablo)
    x = tablo(i, 1)
    For j = 1 To Len(x)
        y = Mid(x, j, 1)
        If y <> " " Then If Not IsNumeric(y) Then x = Replace(x, y, " ")
    Next j
    tablo(i, 1) = Application.Trim(x) 'SUPPRESPACE
Next i
'---restitution---
With [B1].Resize(i - 1)
    .Value = tablo
    .TextToColumns .Cells, xlDelimited, Space:=True 'commande Convertir
End With
End Sub
A+
 

Pièces jointes

  • Extraire(1).xlsm
    18.4 KB · Affichages: 6
Vote positif 0 Vote négatif
Solution
job75

job75

XLDnaute Barbatruc
Fichier (2) avec cette macro plus rapide :
VB: 
Sub Extraire()
Dim tablo, i&, x$, deb%, z$, j%, y$
Application.ScreenUpdating = False
Columns("B").Resize(, Columns.Count - 1).Delete 'RAZ
tablo = [A1].CurrentRegion.Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
For i = 1 To UBound(tablo)
    x = tablo(i, 1)
    deb = 0: z = ""
    For j = 1 To Len(x) + 1
        y = Mid(x, j, 1)
        If deb = 0 Then If IsNumeric(y) Then deb = j
        If deb Then If Not IsNumeric(y) Then z = z & " " & Mid(x, deb, j - deb): deb = 0
    Next j
    tablo(i, 1) = LTrim(z)
Next i
'---restitution---
With [B1].Resize(i - 1)
    .Value = tablo
    .TextToColumns .Cells, xlDelimited, Space:=True 'commande Convertir
End With
End Sub
Sur 50 000 lignes elle s'exécute en 0,5 seconde.
 

Pièces jointes

  • Extraire(2).xlsm
    18.8 KB · Affichages: 4
Vote positif 0 Vote négatif
M

marc.gilliand

XLDnaute Occasionnel
Bonjour,
Merci de votre fichier. Malheureusement, le fait est que j'ai plein d'autres colonnes après la colonne valeur que je souhaite extraire. Et via la macro, tout a disparu. Je vous joins un bout de fichier.
job75 à dit:
Fichier (2) avec cette macro plus rapide :
VB: 
Sub Extraire()
Dim tablo, i&, x$, deb%, z$, j%, y$
Application.ScreenUpdating = False
Columns("B").Resize(, Columns.Count - 1).Delete 'RAZ
tablo = [A1].CurrentRegion.Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
For i = 1 To UBound(tablo)
    x = tablo(i, 1)
    deb = 0: z = ""
    For j = 1 To Len(x) + 1
        y = Mid(x, j, 1)
        If deb = 0 Then If IsNumeric(y) Then deb = j
        If deb Then If Not IsNumeric(y) Then z = z & " " & Mid(x, deb, j - deb): deb = 0
    Next j
    tablo(i, 1) = LTrim(z)
Next i
'---restitution---
With [B1].Resize(i - 1)
    .Value = tablo
    .TextToColumns .Cells, xlDelimited, Space:=True 'commande Convertir
End With
End Sub
Sur 50 000 lignes elle s'exécute en 0,5 seconde.
Cliquez pour agrandir...
Bonjour le forum
Merci, je vous joins un bout de mon fichier. Car j'ai des colonnes à préserver. Voici le lien :
job75 à dit:
Fichier (2) avec cette macro plus rapide :
VB: 
Sub Extraire()
Dim tablo, i&, x$, deb%, z$, j%, y$
Application.ScreenUpdating = False
Columns("B").Resize(, Columns.Count - 1).Delete 'RAZ
tablo = [A1].CurrentRegion.Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
For i = 1 To UBound(tablo)
    x = tablo(i, 1)
    deb = 0: z = ""
    For j = 1 To Len(x) + 1
        y = Mid(x, j, 1)
        If deb = 0 Then If IsNumeric(y) Then deb = j
        If deb Then If Not IsNumeric(y) Then z = z & " " & Mid(x, deb, j - deb): deb = 0
    Next j
    tablo(i, 1) = LTrim(z)
Next i
'---restitution---
With [B1].Resize(i - 1)
    .Value = tablo
    .TextToColumns .Cells, xlDelimited, Space:=True 'commande Convertir
End With
End Sub
Sur 50 000 lignes elle s'exécute en 0,5 seconde.
Cliquez pour agrandir...
Bonjour,
Je souhaiterai vous envoyer un bout de mon fichier, qui contient des Recherchev, des SI, etc... mais le fichier est trop lourd. Quel est le nom du site pour partager des fichiers. Merci d'avance
 
Vote positif 0 Vote négatif
M

marc.gilliand

XLDnaute Occasionnel
Bonjour,
Merci de votre fichier. Malheureusement, le fait est que j'ai plein d'autres colonnes après la colonne valeur que je souhaite extraire. Et via la macro, tout a disparu. Je vous joins un bout de fichier.
job75 à dit:
Fichier (2) avec cette macro plus rapide :
VB: 
Sub Extraire()
Dim tablo, i&, x$, deb%, z$, j%, y$
Application.ScreenUpdating = False
Columns("B").Resize(, Columns.Count - 1).Delete 'RAZ
tablo = [A1].CurrentRegion.Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
For i = 1 To UBound(tablo)
    x = tablo(i, 1)
    deb = 0: z = ""
    For j = 1 To Len(x) + 1
        y = Mid(x, j, 1)
        If deb = 0 Then If IsNumeric(y) Then deb = j
        If deb Then If Not IsNumeric(y) Then z = z & " " & Mid(x, deb, j - deb): deb = 0
    Next j
    tablo(i, 1) = LTrim(z)
Next i
'---restitution---
With [B1].Resize(i - 1)
    .Value = tablo
    .TextToColumns .Cells, xlDelimited, Space:=True 'commande Convertir
End With
End Sub
Sur 50 000 lignes elle s'exécute en 0,5 seconde.
Cliquez pour agrandir...

Bonjour,
Je souhaierai vosu envoyer une partie de mon fichier, car trop lourd en l'état pour vous l'envoyer, le site cjoint ne fonctionne-t-il plus ?
 
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Re, Bonjour Job75

=>marc
[Pour infos]
On joint un fichier allégé (jamais l'original)
Et cette version allégée qui illustre le problème, tu peux la compresser dans un fichier zip
Et joindre ce zip sur le forum

NB: D'autant que la charte du forum déconseille d'héberger les fichiers exemple ailleurs que dans les discussions du forum.
 
Vote positif 0 Vote négatif
M

marc.gilliand

XLDnaute Occasionnel
Voici mon
marc.gilliand à dit:
Bonjour,
Merci de votre fichier. Malheureusement, le fait est que j'ai plein d'autres colonnes après la colonne valeur que je souhaite extraire. Et via la macro, tout a disparu. Je vous joins un bout de fichier.


Bonjour,
Je souhaierai vosu envoyer une partie de mon fichier, car trop lourd en l'état pour vous l'envoyer, le site cjoint ne fonctionne-t-il plus ?
Cliquez pour agrandir...
Bonjour,

Voici mon fichier ZIP. Merci d'avance de votre aide.
 

Pièces jointes

  • Froneri_Toute_la_gamme_V5.zip
    899.6 KB · Affichages: 1
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Il suffit d'adapter pour restituer la colonne X à partir de la colonne AO :
VB: 
Sub Extraire()
Dim tablo, i&, x$, deb%, z$, j%, y$
Application.ScreenUpdating = False
Columns("AO").Resize(, Columns.Count - Columns("AO").Column + 1).ClearContents 'RAZ
tablo = [A1].CurrentRegion.Resize(, 24) 'matrice, plus rapide, au moins 2 éléments
For i = 1 To UBound(tablo)
    x = tablo(i, 24) 'colonne X
    deb = 0: z = ""
    For j = 1 To Len(x) + 1
        y = Mid(x, j, 1)
        If deb = 0 Then If IsNumeric(y) Then deb = j
        If deb Then If Not IsNumeric(y) Then z = z & " " & Mid(x, deb, j - deb): deb = 0
    Next j
    tablo(i, 1) = LTrim(z)
Next i
'---restitution---
With [AO1].Resize(i - 1)
    .Value = tablo
    .TextToColumns .Cells, xlDelimited, Space:=True 'commande Convertir
End With
End Sub
 

Pièces jointes

  • Froneri_Toute_la_gamme_V5.zip
    955.6 KB · Affichages: 3
Vote positif 0 Vote négatif
M

marc.gilliand

XLDnaute Occasionnel
job75 à dit:
Il suffit d'adapter pour restituer la colonne X à partir de la colonne AO :
VB: 
Sub Extraire()
Dim tablo, i&, x$, deb%, z$, j%, y$
Application.ScreenUpdating = False
Columns("AO").Resize(, Columns.Count - Columns("AO").Column + 1).ClearContents 'RAZ
tablo = [A1].CurrentRegion.Resize(, 24) 'matrice, plus rapide, au moins 2 éléments
For i = 1 To UBound(tablo)
    x = tablo(i, 24) 'colonne X
    deb = 0: z = ""
    For j = 1 To Len(x) + 1
        y = Mid(x, j, 1)
        If deb = 0 Then If IsNumeric(y) Then deb = j
        If deb Then If Not IsNumeric(y) Then z = z & " " & Mid(x, deb, j - deb): deb = 0
    Next j
    tablo(i, 1) = LTrim(z)
Next i
'---restitution---
With [AO1].Resize(i - 1)
    .Value = tablo
    .TextToColumns .Cells, xlDelimited, Space:=True 'commande Convertir
End With
End Sub
Cliquez pour agrandir...
Bonjour,
Merci, le seul hic, c'est que je souhaite que l'extraction de ces données ne soient pas en AO AP AQ, mais en Y, Z et AA. Merci de votre aide.
 
Vote positif 0 Vote négatif
M

marc.gilliand

XLDnaute Occasionnel
marc.gilliand à dit:
Bonjour,
Merci, le seul hic, c'est que je souhaite que l'extraction de ces données ne soient pas en AO AP AQ, mais en Y, Z et AA. Merci de votre aide.
Cliquez pour agrandir...
Re-Bonjour,
Et lorsque je rajoute des données, XL m'efface complètement toutes les données. Bizarre. N'y a-t-il pas un moyen pour qu'à l'ouverture du fichier les remontées ne se calculent pas et que c'est seulement qu'une fois que j'active la macro que celle-ci s'exécute ? Merci de votre aide.
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bon on y arrive :
VB: 
Sub Extraire()
Dim tablo, i&, x$, deb%, n%, z$, j%, y$
tablo = [A1].CurrentRegion.Resize(, 24) 'matrice, plus rapide, au moins 2 éléments
For i = 1 To UBound(tablo)
    x = tablo(i, 24) 'colonne X
    deb = 0: n = 0: z = ""
    For j = 1 To Len(x) + 1
        y = Mid(x, j, 1)
        If deb = 0 Then If IsNumeric(y) And n < 3 Then n = n + 1: deb = j 'limite de 3 nombres
        If deb Then If Not IsNumeric(y) Then z = z & Chr(1) & Mid(x, deb, j - deb): deb = 0
    Next j
    tablo(i, 1) = Mid(z, 2)
Next i
'---restitution---
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With [Y1].Resize(i - 1) '1ère colonne de restitution
    tablo(1, 1) = .Cells(1, 1) & Chr(1) & .Cells(1, 2) & Chr(1) & .Cells(1, 3) 'titres
    .Value = tablo
    .TextToColumns .Cells, xlDelimited, Other:=True, OtherChar:=Chr(1) 'commande Convertir
End With
End Sub
Le nombre d'extractions est limité à 3.

La macro s'exécute seulement quand on clique sur le bouton. Extraire
 

Pièces jointes

  • Froneri_Toute_la_gamme_V6.zip
    956.4 KB · Affichages: 2
Dernière édition:
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Finalement plutôt qu'une procédure Sub il vaut mieux une fonction VBA :
VB: 
Function Extract(x$)
Dim a(1 To 3), i%, y$, deb%, n%
a(1) = "": a(2) = "": a(3) = "" 'pour éviter les valeurs zéro
For i = 1 To Len(x) + 1
    y = Mid(x, i, 1)
    If deb = 0 Then If IsNumeric(y) And n < 3 Then n = n + 1: deb = i 'limite de 3 nombres
    If deb Then If Not IsNumeric(y) Then a(n) = Val(Mid(x, deb, i - deb)): deb = 0
Next i
Extract = a 'vecteur ligne
End Function
Le code doit être placé impérativement dans un module standard.

Sélectionnez Y2:AA2, entrez la formule =Extract(X2) dans la barre de formule et validez en bloc matriciellement par Ctrl+Maj+Entrée puis tirez Y2:AA2 vers le bas.
 

Pièces jointes

  • Froneri_Toute_la_gamme_V7.zip
    955.1 KB · Affichages: 3
Vote positif 0 Vote négatif
M

marc.gilliand

XLDnaute Occasionnel
job75 à dit:
Finalement plutôt qu'une procédure Sub il vaut mieux une fonction VBA :
VB: 
Function Extract(x$)
Dim a(1 To 3), i%, y$, deb%, n%
a(1) = "": a(2) = "": a(3) = "" 'pour éviter les valeurs zéro
For i = 1 To Len(x) + 1
    y = Mid(x, i, 1)
    If deb = 0 Then If IsNumeric(y) And n < 3 Then n = n + 1: deb = i 'limite de 3 nombres
    If deb Then If Not IsNumeric(y) Then a(n) = Val(Mid(x, deb, i - deb)): deb = 0
Next i
Extract = a 'vecteur ligne
End Function
Le code doit être placé impérativement dans un module standard.

Sélectionnez Y2:AA2, entrez la formule =Extract(X2) dans la barre de formule et validez en bloc matriciellement par Ctrl+Maj+Entrée puis tirez Y2:AA2 vers le bas.
Cliquez pour agrandir...

C'est parfait, je vous remercie infiniment. C'est génial
 
Vote positif 0 Vote négatif

Discussions similaires

S
  • Résolu(e)
XL 2021 Extraire valeurs après caractère spécial ou numérique
2
Réponses
20
Affichages
1 K
R@chid
R@chid
J
  • Question
XL 2021 Résolu - Extractions de valeurs Ligne pour créer des lignes isolées / Macro Séparer Valeurs
Réponses
14
Affichages
339
JM04082023!
J
J
  • Question
Microsoft 365 extraction VBA avec formule si
Réponses
10
Affichages
505
Phil69970
Phil69970
P
  • Question
Microsoft 365 extraction de valeur d'un tableau avec critère mois et année
Réponses
13
Affichages
596
JHA
J
N
  • Résolu(e)
Microsoft 365 Rendre des bouton inactifs si des TextBox sont remplies ou pas.
Réponses
5
Affichages
119
NONO14
N
cathodique
  • Résolu(e)
XL 2010 tableau de comptage sans doublon
2 3
Réponses
44
Affichages
1 K
cathodique
cathodique
C
  • Question
XL 2021 VBA - créer une boucle de calcul pour remplir un tableau à partir de 2 autres sur une même feuille
Réponses
7
Affichages
516
clineM
C
K
  • Question
XL 2019 somme d'une plage après chaque saut de ligne
Réponses
10
Affichages
376
Kaganaias
K
G
  • Question
Microsoft 365 Reconstitution stock a date - besoin d'aide
Réponses
0
Affichages
411
GregH
G
J
  • Question
XL 2016 Tableau de bord - report de données
2
Réponses
16
Affichages
1 K
chris
chris

Membres actuellement en ligne

15 membres et 168 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 664
Messages
2 111 675
Membres
111 256
dernier inscrit
cvwvoizhjf