Excel: extraction de caracteres Résolu

Question

Bonjour à tous,

Je viens a vous car j'ai 2 petit soucis 

j'ai un listing de 8000 lignes avec des denominations social tel que "SPRL diapason, ASBL yatra, BVBA philips" et je dois les extraires dans une autre colone sans effacer. Les dénominations ce trouve dans la colone B et je dois mettre les (SPRL,SCRL,ASBL,BVBA,SCRL, SA, SC) dans la colone A. 

Dans ce listing ce trouve aussi certaine dénomination tel que 
"Ombre de la Lumière (A la)" 
et j aurai voulu savoir si il existai une macro pour prendre ce qu'il ya dans la paranthese la mettre au début et supprimer les parentheses avec le contenu 

j'espere qu'il existe une solution a mon probleme et que vous voudrez bien me la partager 

je vous remercie d'avance 

cordialement

pijaku · Answer

Bonjour,
J'avoue ne pas tout piger. D'un côté tu dis avoir des dénominations SPRL diapason, ASBL yatra, BVBA philips que tu dois extraire, ensuite tu dois mettre en col A des abréviations :  et je dois mettre les (SPRL,SCRL,ASBL,BVBA,SCRL, SA, SC) dans la colone A.
Et pour finir tu parles de choses à extraire entre parenthèses... On s'y perds un peu je crois.
1- repose mieux ta question,
2- joinds un fichier exemple (en utilisant cjoint.fr par exemple) sans données confidentielles, avec ce que tu as et ce que tu veux...

Polux31 · Answer

Bonjour le fofo


Non il n'existe pas de "macro" prête à l'emploi.

Voilà un exemple à adapter :

'Procédure principale
Sub Main()
Dim ws As Worksheet
Dim derlig As Long
Dim i As Long

    Set ws = Worksheets(1)
    derlig = ws.Range("B65536").End(xlUp).Row
    
    For i = 1 To derlig
        If InStr(1, ws.Range("B" & i).Value, "(") = 0 Then
            ws.Range("A" & i).Value = returnPrefixe(ws.Range("B" & i).Value)
        Else
            ws.Range("B" & i).Value = returnModif(ws.Range("B" & i).Value)
        End If
    Next i
    
End Sub

'Fonction qui retourne le préfixe 
Private Function returnPrefixe(ByVal str As String) As String
Dim mTab

    mTab = Split(str, " ")
    
    returnPrefixe = mTab(0)
    
End Function

'Fonction qui retourne le texte modifié
Private Function returnModif(ByVal str As String) As String
Dim char As String

    If InStr(str, ")") = 0 Or Right(str, 1) = "(" Then
        returnModif = ""
        Exit Function
    End If
    
    char = Mid(str, InStrRev(str, "(") + 1)
    
    char = Mid(char, 1, Len(char) - 1)
    
    returnModif = char & " " & Mid(str, 1, Len(char) + 3)

End Function

;o)

mathraxe · Answer

je reformule j ai un listing de prospects (Nom de la societé, adresse, N°,code postal,ville, etc..) 

dans le Nom de la societé (colonne B) j ai des "SPRL diapason, ASBL yatra, BVBA philips" on m'a demandé de faire une colonne A et de mettre en évidence le statut de la société.

Et on m'a demandé aussi de retirer ce qui été entre parenthese dans la colonne B et de le mettre devant la dénomination pour etre plus conforme ex: auberge (l') = l'auberge

j'ai fais un printscreen pour mieux comprendre 
https://www.cjoint.com/?0kuj5hCbnLd

encore merci de votre aide

pijaku · Answer

re-
N'ayant pas son talent, je me suis permis de reprendre légèrement les codes donnés par Polux31 ci-dessus. Je les ai juste adaptés à la nouvelle situation décrite par mathraxe...

Sub Main()
Dim ws As Worksheet
Dim derlig As Long
Dim i As Long
Dim NomTableau As Variant
Dim val As Variant
   
    NomTableau = Array("SPRLU", "SPRL", "SCRL", "ASBL", "BVBA", "SA", "SC")
    
    Set ws = Worksheets(1)
    derlig = ws.Range("B65536").End(xlUp).Row
    
    For i = 2 To derlig
        For Each val In NomTableau
            If ws.Range("B" & i).Value Like "*" & val & "*" Then
                ws.Range("A" & i).Value = val
                ws.Range("B" & i).Value = Replace(ws.Range("B" & i).Value, val, "")
            End If
        Next
        If InStr(1, ws.Range("B" & i).Value, "(") <> 0 Then
            ws.Range("B" & i).Value = returnModif(ws.Range("B" & i).Value)
        End If
    Next i
    
End Sub

Private Function returnModif(ByVal str As String) As String
Dim char As String

    If InStr(str, ")") = 0 Or Right(str, 1) = "(" Then
        returnModif = ""
        Exit Function
    End If
    
    char = Mid(str, InStrRev(str, "(") + 1)
    If InStr(char, " ") <> 0 Then
        char = Replace(char, " ", "")
    End If
    char = Mid(char, 1, Len(char) - 1)
    char = char & " " & Replace(str, char, "")
    char = Replace(char, "(", "")
    char = Replace(char, ")", "")
    
    returnModif = char

End Function

--
Cordialement,
-- Il n'y a rien de tel qu'une question idiote, seulement une réponse idiote. A.Einstein --

mathraxe · Answer

Pijaku je dois tous simplement te dire un grand grand merci!!!

ta macro est superbe :-) 

encore merci pour l aide ça fait plaisir

Excel: extraction de caracteres

5 réponses

Newsletters