Extraire un morceau de texte et le verifier Fermé

Question

Bonjour, 

 Je n'arrive pas à trouver la Macro EXCEL, qui me permettrait de  :

Je dois lire une liste de NOM qui pour certain finissent par "(S)". ex : DURAND (S)
Si je trouve (S), je veux copier le NOM complet vers une autre cellule.

Merci pour votre Aide
JEROME


Configuration: Windows 7 / Firefox 3.6.16

Vaucluse · Answer

Bonjour

a tout hasard:
Peut être créer une liste avec uniquement les noms qui se terminent par S sans macro
la liste en A
en B1=SI(DROITE(A1)="s";A1;"")
il suffit ensuite de faire un copier coller valeur et de trier pour avoir la liste

ou pour créer une liste continue, à adapter:
en colonne B, à partir de B2, B1 devant être vide:
=SI(DROITE(A1)="s";MAX($B$1:B1)+1;0)
en colonne C, en C2:
=SI(LIGNE()-1>MAX(B:B);"";INDEX($A$2:$A$1000;EQUIV(LIGNE()-1;$A$1:$A$1000;0);1))

crdlmnt

ccm81 · Answer

bonjour à tous 

peut être quelque chose comme ça  pour recopier dans la colonne suivante

Private Sub CommandButton1_Click() 
Const lideb = 1 
Const lifin = 16 
Const co = 5 
Dim li As Long 
For li = lideb To lifin 
  If Right(Cells(li, co).Value, 3) = "(S)" Then 
    Cells(li, co).Offset(0, 1).Value = Cells(li, co).Value 
  End If 
Next li 
End Sub

bonne suite

michel_m · Answer

bonjour ccm

peut-^tre + rapide sur 4000 lignes et liste des (s) groupée bien qu'une solution  sans macro semblerait largement facile et suffisante... mais une macro est impérative, qu'il a dit, Jérome  :-)

Const lig As Byte = 1 'ligne départ
Const col As Byte = 1 'colonne à traiter
Const cible As String = "B2" ' départ cellules de restitution

Sub essai()
Dim cptr As Integer, cptr_s As Integer
Dim T_s, Nbre_s

ReDim T_s(0) As String
With Sheets(1)
    derlig = .Cells(.Rows.Count, col).End(xlUp).Row
For cptr = 0 To derlig
    Nbre_s = Split(.Cells(cptr + lig, col), "(")
    If UBound(Nbre_s) > 0 Then
        ReDim Preserve T_s(cptr_s)
        T_s(cptr_s) = Trim(Nbre_s(0))
        cptr_s = cptr_s + 1
    End If
Next
End With

Application.ScreenUpdating = False
Sheets(2).Range(cible).Resize(cptr_s, 1) = Application.Transpose(T_s)
End Sub

Extraire un morceau de texte et le verifier

3 réponses

Discussions similaires