Chercher et supprimer chaine de caractère dans une cellule

Bonjour,

Bonjour,

Dans une colonne A avec chaque cellule débutant ligne 6 contenant 10 chiffres un espace puis une référence avec 3 Lettres qui ne change pas suivi de 17 chiffres ( ou inversement )

exemple 0478194601 RBS01000000141001036

0385812915 RBS01000000141395929

ou RBS01000000141088139 0388543725

Je voudrais supprimer cette référence commençant par RBS avec ses 17chiffres et ne garder que les 10 autres chiffres

Si j'exprime mon code en phrase ci dessous ( je ne sais pas coder )

J'ai vu qu'avec la fonction Instr() je devrais pouvoir trouver la position de RBS ou du R et supprimer les 17 chiffres suivant ou ne rien faire si la Ref en RBS n'est pas présente. A répéter dans chaque cellule non vide de ma colonne

Merci pour votre aide

Bonsoir Yam71 le forum

a+

Papou

'Macro Faite par Pascal RICHARD Paritec le 16/03/2017
Option Explicit

Sub test()
    Dim aa, i&, x
    With Feuil1
        aa = .Range("A18:A" & .Range("A" & Rows.Count).End(xlUp).Row)
    End With
    For i = 1 To UBound(aa)
        x = Split(aa(i, 1), Chr(10))
        If Len(x(0)) = 10 Then aa(i, 1) = x(0) Else aa(i, 1) = x(1)
    Next i
    Feuil1.Range("A18").Resize(UBound(aa), UBound(aa, 2)) = aa
End Sub

Re yam71 le forum

j'avais pas vu que la liste commençait à ligne 6 et que tu avais aussi des cellules qui n'avaient pas de retour donc bug avec la première macro

Voilà avec les modifs, mais une des cellules n'a ni espace ni retour donc là traitement impossible du moins avec le split

a+

Papou

'Macro Faite par Pascal RICHARD Paritec le 16/03/2017
Option Explicit

Sub test()
    Dim aa, i&, x
    With Feuil1
        aa = .Range("A6:A" & .Range("A" & Rows.Count).End(xlUp).Row)
    End With
    For i = 1 To UBound(aa)
        If aa(i, 1) <> "" Then
            x = Split(aa(i, 1), Chr(10))
            If UBound(x) > 0 Then
                If Len(x(0)) = 10 Then aa(i, 1) = x(0) Else aa(i, 1) = x(1)
            End If
        End If
    Next i
    Feuil1.Range("A6").Resize(UBound(aa), UBound(aa, 2)) = aa
End Sub

Salut Yam, Paritec,

Bonjour le forum,

une solution à tester.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'
Dim tTab
'
If Target.Address = [A5].Address Then
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    '
    iRow = Cells(Rows.Count, 1).End(xlUp).Row
    tTab = Range("A6:A" & iRow)
    '
    For x = 1 To UBound(tTab, 1)
        For y = 1 To Len(tTab(x, 1))
            If Asc(Mid(tTab(x, 1), y, 1)) > 64 And Asc(Mid(tTab(x, 1), y, 1)) < 91 Then
                tTab(x, 1) = IIf(y > 1, Left(tTab(x, 1), y - 1), Right(tTab(x, 1), Len(tTab(x, 1)) - 20))
                Exit For
            End If
        Next
    Next
    Range("A6:A" & iRow) = tTab
    '
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End If

End Sub

A+

Bonjour,

Salut Paritec,

Sans modifier la structure de ton code initial, tu peux faire :

            x = Split(Chr(10) & aa(i, 1), Chr(10))

De cette façon tu es sûr d'avoir toujours un tableau, même avec une cellule vide, d'au moins 2 éléments.

Et pour la suite, il suffit de remplacer 0 par 1 et 1 par 2 (seuls les éléments 1 et 2 t'intéressent)...

Cordialement.

Salut Curulis !

J'avais pas vu ton passage... Pourquoi lier à un évènement SelectionChange ?

Et le code de Paritec est simple et parfait pour cette opération... !

Bonne journée.

Re Mferrand le forum

Et le code de Paritec est simple et parfait pour cette opération... !

merci Mferrand

et pour le

x = Split(Chr(10) & aa(i, 1), Chr(10))

oui tu as raison on pense pas toujours à tout!!

dans plusieurs têtes il y en a plus que dans une

merci encore

a+

Papou

merci beaucoup pour votre aide , est il possible de faire un recap du code final avec la modif ci dessous

x = Split(Chr(10) & aa(i, 1), Chr(10))

ne comprenant pas le code ça me fait une erreur

EDIT: j'ai testé ton code paritec (j'ai bien accorder le nom de la feuille entre le code et la macro) il ne se passe rien, j'ai du loupé un truc

Merci!

Bonjour Yam71 le forum

oui c'est possible de te faire le détail de la deuxième version.

En faite les deux versions sont rigoureusement identique sauf que le fait de rajouter chr(10) & permet lorsque la cellule est vide de spliter la cellule est de trouver un résultat puisque on joint le résultat à la demande.

et ensuite bien sur tu vas donc splitter sur trois colonnes à la place de deux et il fallait donc aussi changer les ref.

En résumé la première version est opérationnelle avec un test sur les cellules vides et l'autre non, chacun peut choisir ce qu'il apprécie le plus.

a+

papou

'Macro Faite par Pascal RICHARD Paritec le 16/03/2017
Option Explicit

Sub test()
    Dim aa, i&, x
    With Feuil1
        aa = .Range("A6:A" & .Range("A" & Rows.Count).End(xlUp).Row)
    End With
    For i = 1 To UBound(aa)
        x = Split(Chr(10) & aa(i, 1), Chr(10))
        If UBound(x) > 1 Then
            If Len(x(1)) = 10 Then aa(i, 1) = x(1) Else aa(i, 1) = x(2)
        End If
    Next i
    Feuil1.Range("A6").Resize(UBound(aa), UBound(aa, 2)) = aa
End Sub

Merci beaucoup pour le temps passer! ça fontionne bien

a++

Je repasse avec retard...

Pour Paritec : de rien ! C'était un plaisir ! Ton code est parfaitement indenté... et en plus il me semble que beaucoup d'éléments de personnalisation tu optes pour des choix que je retiens également !! C'est pas tous les jours, je reviendrai en lire...

Yam71, Bonne continuation...

Et bonne soirée.