supprimer que les lettres

O

Olyxier

XLDnaute Occasionnel
Bonjour

j'ai un super code que l'on ma donnée ici en 2008.

comme je suis toujours aussi mauvais qu'à l'époque j'ai encore besoin d'aide.

ce code supprime les lettres ainsi que les points et autres guillemet

Dim C As Range
Dim i As Byte
Dim nombre As String

For Each C In Range("CY15:CY34")
If Not IsEmpty(C) Then
For i = 1 To Len(C)
If IsNumeric(Mid(C, i, 1)) Then
nombre = nombre & Mid(C, i, 1)
End If
Next i
If nombre <> "" Then C = CDbl(nombre)
nombre = "0"
End If
Next C

maintenant la modification que je voudrais est que dans cette ligne le code laisse les guillemets ainsi que les chiffres et les D.

exemple 5as 0ar Dat 4as 4as Das (09) 2as 1as 8rt...

ce qui doit rester: 50D44D(09)218

cela est il possible, merci a vous pour votre aide et bonne soirée:eek:
 
Trier par date Trier par votes
tototiti2008

tototiti2008

XLDnaute Barbatruc
Re : supprimer que les lettres

Bonjour Olyxier,

à tester :

Code: 
Dim C As Range
Dim i As Byte
Dim texte As String

For Each C In Range("CY15:CY34")
If Not IsEmpty(C) Then
texte = ""
For i = 1 To Len(C)
If IsNumeric(Mid(C, i, 1)) or Mid(C, i, 1)="(" or Mid(C, i, 1)=")" or Mid(C, i, 1)="D" Then
texte = texte & Mid(C, i, 1)
End If
Next i
If texte <> "" Then C = texte 
End If
Next C
 
Vote positif 0 Vote négatif
C

Caillou

XLDnaute Impliqué
Re : supprimer que les lettres

Bonjour,

Essayes ceci :

Code: 
  Dim C As Range
  Dim i As Byte
  Dim nombre As String
  Dim l As String
  
  For Each C In Selection 'Range("CY15:CY34")
    If Not IsEmpty(C) Then
      For i = 1 To Len(C)
        l = Mid(C, i, 1)
        If IsNumeric(l) Or l = "D" Or l = "(" Or l = ")" Then
          nombre = nombre & Mid(C, i, 1)
        End If
      Next i
      If nombre <> "" Then C = nombre
      nombre = ""
    End If
  Next C

Caillou
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re : supprimer que les lettres

Bonjour le fil,

C'est comme tototiti, que je salue :) et un peu pour le fun :

Code: 
Dim C As Range, i As Byte, x$, txt$
For Each C In Range("CY15:CY34")
  If Not IsEmpty(C) Then
    For i = 1 To Len(C)
      x = Mid(C, i, 1)
      If IsNumeric(x) Or InStr("D()", x) Then txt = txt & x
    Next i
    C = txt
    txt = ""
  End If
Next C

Edit : salut aussi Caillou

A+
 
Dernière édition:
Vote positif 0 Vote négatif
JNP

JNP

XLDnaute Barbatruc
Re : supprimer que les lettres

Bonsoir le fil :),
Pour le fun et pour faire plaisir à Jean-Marie :p
Code: 
Dim m, mm, tmp$
Dim C As Range
For Each C In Range("CY15:CY34")
With CreateObject("vbscript.regexp")
    .Global = True: .IgnoreCase = True: .Pattern = "[\d()D]*"
    Set mm = .Execute(C.Text)
    For Each m In mm
        tmp = tmp & m.Value
    Next m
End With
C = tmp
tmp = ""
Next
Bonne soirée :cool:
 
Vote positif 0 Vote négatif
JNP

JNP

XLDnaute Barbatruc
Re : supprimer que les lettres

Re :),
je n'avais pas vu la demande de blanc :eek:
Code: 
Dim m, mm, tmp$
Dim C As Range
For Each C In Range("CY15:CY34")
With CreateObject("vbscript.regexp")
    .Global = True: .IgnoreCase = True: .Pattern = "[\d()D]*"
    Set mm = .Execute(C.Text)
    For Each m In mm
        If m <> "" Then
        tmp = tmp & m.Value & " "
        End If
    Next m
End With
C = Replace(Replace(tmp, "( ", "("), " )", ")")
tmp = ""
Next
Bonne soirée :cool:
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re : supprimer que les lettres

Salut Jean-Noël :)

Il me semble qu'Olyxier veut des espaces partout sauf pour un nombre entre parenthèses...

Alors à la fin il faut faire un traitement sur tout le texte pour enlever ces espaces. Un peu lourd :eek:

A+
 
Vote positif 0 Vote négatif
tototiti2008

tototiti2008

XLDnaute Barbatruc
Re : supprimer que les lettres

Bonjour JNP,
Re,

je reprends le code de job parce que je ne comprends rien à regExp...

Code: 
Dim C As Range, i As Byte, x$, txt$, OuvrPar As Boolean
For Each C In Range("CY15:CY34")
  If Not IsEmpty(C) Then
OuvrPar = False
    For i = 1 To Len(C)
      x = Mid(C, i, 1)
      If IsNumeric(x) Or InStr("D()", x) Then txt = txt & x & " "
    If x = ")" Then OuvrPar = False
    If x = "(" Or OuvrPar Then
    txt = Left(txt, Len(txt) - 1)
    OuvrPar = True
    End If
    Next i
    C = txt
    txt = ""
  End If
Next C
 
Dernière édition:
Vote positif 0 Vote négatif
JNP

JNP

XLDnaute Barbatruc
Re : supprimer que les lettres

Re :),
tototiti2008 à dit:
je reprends le code de job parce que je ne comprends rien à regExp...
Cliquez pour agrandir...
C'est Jean-Marie qui m'a poussé :D...
Mais c'est vrai qu'il y a une notion de masque très puissante, et assez simple à utiliser ;).
C'est le Pattern qui fait tout : "[\d()D]*"
[] est tout ce qu'on accepte comme caractère
\d est équivalent à 0-9, donc tout ce qui est numérique
* sert à dire qu'on accepte autant de fois ce qui est entre crochets
L'avantage, c'est qu'il est aisément modifiable.
Par contre, à partir du moment où on mets des blancs partout, pourquoi ne pas utiliser
Code: 
Replace(Replace(txt, "( ", "("), " )", ")")
A + :cool:
 
Vote positif 0 Vote négatif
tototiti2008

tototiti2008

XLDnaute Barbatruc
Re : supprimer que les lettres

Re,

Par contre, à partir du moment où on mets des blancs partout, pourquoi ne pas utiliser
Code:
Replace(Replace(txt, "( ", "("), " )", ")")
Cliquez pour agrandir...

dis moi si je me trompe, s'il y a 5 chiffres ou D entre les parenthèses ça n'enlèvera pas les espace entre chiffres ou D, seulement ceux collés aux parenthèses ?

Pour RegExp je te remercie d'essayer de me convertir mais la littérature sur le sujet m'a semblé si indigeste, et comme je n'en ai jamais eu un besoin vital...
 
Vote positif 0 Vote négatif
JNP

JNP

XLDnaute Barbatruc
Re : supprimer que les lettres

Encore moi :p...
D'ailleurs, si la structure est bien celle donnée au départ, et en tenant compte du titre "supprimer que les lettres, l'ajout d'un espace dans le Pattern donne aussi le bon résultat
Code: 
Dim m, mm, tmp$
Dim C As Range
For Each C In Range("CY15:CY34")
With CreateObject("vbscript.regexp")
    .Global = True: .IgnoreCase = True: .Pattern = "[\d()D ]*"
    Set mm = .Execute(C.Text)
    For Each m In mm
        If m <> "" Then
        tmp = tmp & m.Value
        End If
    Next m
End With
C = tmp
tmp = ""
Next
Bonne soirée :cool:
 
Dernière édition:
Vote positif 0 Vote négatif

Discussions similaires

_l_ours
  • Résolu(e)
XL 2016 Macro Dim c As Range, i As Long
Réponses
8
Affichages
221
mapomme
mapomme
S
  • Résolu(e)
XL 2016 problème de filtre dans listbox
2 3 4
Réponses
51
Affichages
1 K
saidoush
S
pompaero
  • Résolu(e)
Microsoft 365 Amélioration codage
Réponses
4
Affichages
209
pompaero
pompaero
A
  • Résolu(e)
Microsoft 365 Correction du code vba
Réponses
5
Affichages
181
AD95
A
A
  • Question
Microsoft 365 Code VBA Envoi contenu tableau Excel par Email
Réponses
1
Affichages
113
Phil69970
Phil69970
U
  • Résolu(e)
Autres Centrer ou Annuler Centrer
Réponses
12
Affichages
232
un internaute
U
Messan
  • Résolu(e)
XL 2019 Organiser les données dans listbox
Réponses
2
Affichages
384
Messan
Messan
G
  • Question
Microsoft 365 Saut de ligne dans une cellule
Réponses
3
Affichages
138
GClaire
G
HAZM0G
  • Question
Microsoft 365 Essaie de supprimer les pages vierges d'un document qui a un nombre de page variable
Réponses
1
Affichages
173
mromain
mromain
M
  • Question
Microsoft 365 Modifier code et format textbox
2 3
Réponses
35
Affichages
709
Marvin57
M

Membres actuellement en ligne

22 membres et 343 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 199
Messages
2 086 159
Membres
103 145
dernier inscrit
lea.