copier mot en majuscule d'une cellule vers une autre

[r0man0]

Bonjour, j'ai un soucis, je dois récupérer certaines informations en majuscules parmi d'autre en minuscule, se trouvant toutes dans une cellule, par exemple j'ai en D3 "RIORIORIORIO/blablabla/bibibibi/GUGUGUGU/...etc..." sachant que les infos entre slash sont en nombre variable il peut y en avoir 5 comme 12, 10, 11, etc...
Donc pour résumer j'aimerai pouvoir copier les mots en majuscule de la cellule concernée vers une autre, et ceci pour toute ma plage de cellules non-vides.

 

[Gurgeh]

Re : copier mot en majuscule d'une cellule vers une autre

Salut r0man0,

Pour voir si j'ai bien compris, dans ton exemple tu voudrais récupérer "RIORIORIORIOGUGUGUGU", c'est ça ?

Je peux te proposer la fonction suivante en VBA, qui prend en argument un texte et te renvoie le texte débarrassé de tout ce qui n'est pas une majuscule :

Function QueLesMajuscules(ChaîneDépart As String) As String
    QueLesMajuscules = ""
    For i = 1 To Len(ChaîneDépart)
        Caractèrei = Mid(ChaîneDépart, i, 1)
        If Asc(Caractèrei) >= 65 And Asc(Caractèrei) <= 90 Then QueLesMajuscules = QueLesMajuscules & Caractèrei
    Next i
End Function

Est ce que cela peut être le début d'une réponse à ton expression de besoin ?

Gurgeh

 

[natorp]

Re : copier mot en majuscule d'une cellule vers une autre

Bjr r0man0 et Gurgeh

r0man0 : quel est le résultat attendu à partir de ton exemple ?

Cordialement, Gérard

 

[phlaurent55]

Re : copier mot en majuscule d'une cellule vers une autre

Bonjour Romano,

Voir fichier joint
à adapter

à+
Philippe

 

[r0man0]

Re : copier mot en majuscule d'une cellule vers une autre

Bonjour gurgeh, oui il me semblait bien que j'allais devoir utiliser une fonction, malheureusement et c'est là tout le problème je ne vois pas comment on intègre ça avec un code type sub ()
cordialement,
r0man0.

 

[r0man0]

Re : copier mot en majuscule d'une cellule vers une autre

Bonjour natorp et phlaurent55, et bien premièrement je souhaiterai obtenir comme résultat à partir de ma cellule D3 "RIORIORIORIO/blablabla/bibibibi/GUGUGUGU/...etc..." trois cellules avec dans cet ordre D4 "RIORIORIORIO" D5 "GUGUGUGU" et D6 le restant en minuscule.
Dans un second temps je vais regarder de plus près le fichier que tu m'as posté phlaurent55 et puis je te dirai ce qu'il en ai.
Merci à tous.

 

[Gurgeh]

Re : copier mot en majuscule d'une cellule vers une autre

D6 le restant en minuscule

-> donc tous les caractères de D3 qui ne sont pas des majuscules vont se retrouver dans D6 ? Y compris les "/" ?

Gurgeh

 

[r0man0]

Re : copier mot en majuscule d'une cellule vers une autre

oui gurgeh
j'ai essayé quelquechose en modifiant ce que phlaurent55 m'a posté je te présente le code, j'ai voulu supprimer toutes les cellules qui ne contenait pas de majuscule, or il se trouve que j'ai des infos avec comme première lettre une majuscule, je suis un peu embêté.

derligne = Range("D65535").End(xlUp).Row
Range("E1:O" & derligne).ClearContents
Application.ScreenUpdating = False
    Range("D1:D" & derligne).Select
    selection.TextToColumns Destination:=Range("E1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="/", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, _
        1)), TrailingMinusNumbers:=True

For Each cel In Range("E1:O" & derligne)
If UCase(cel) <> cel Then cel.Delete Shift:=xlToLeft
Next cel

 

[Gurgeh]

Re : copier mot en majuscule d'une cellule vers une autre

Bon, alors je te propose la procédure suivante (à adapter pour ta feuille, j'ai supposé que l'on partait de D3

Sub r0man0()
    Dim CelluleDépart As Range
    
    Set CelluleDépart = Range("D3")
    ChaîneATraiter = CelluleDépart.Value
    'La colonne en cours nous sert à savoir dans quel colonne on doit écrire le prochain morceau de chaîne
    ColonneEnCours = CelluleDépart.Column + 1
    
    If ChaîneATraiter <> "" Then
        'On parcourt tous les caractères de la chaîne
        For i = 1 To Len(ChaîneATraiter)
            CaractèreEnCours = Mid(ChaîneATraiter, i, 1)
            'Si c'est une majuscule, on l'ajoute à MotEnMajuscule
            If Asc(CaractèreEnCours) >= 65 And Asc(CaractèreEnCours) <= 90 Then
                MotEnMajuscule = MotEnMajuscule & CaractèreEnCours
            Else
                'Si c'est une minuscule, alors on écrit le MotEnMajuscule dans la colonne en cours
                'Et on repart pour un nouveau MotEnMajuscule
                If MotEnMajuscule <> "" Then
                    Cells(CelluleDépart.Row, ColonneEnCours).Value = MotEnMajuscule
                    MotEnMajuscule = ""
                    ColonneEnCours = ColonneEnCours + 1
                End If
                'Et on ajoute les minuscules à MotEnMinuscule
                MotEnMinuscule = MotEnMinuscule & CaractèreEnCours
            End If
        Next i
        'Une fois qu'on a traité toutes les majuscules, on écrit dans la dernière colonne les caractères en minuscule
        Cells(CelluleDépart.Row, ColonneEnCours).Value = MotEnMinuscule
    End If
End Sub

A ta dispo si questions

Gurgeh

 

[r0man0]

Re : copier mot en majuscule d'une cellule vers une autre

Merci
Désolé de ne peux t'avoir répondu plus tôt, je reviens vers toi car j'ai un petit problème à résoudre concernant le code, en effet j'aimerai pouvoir ne garder que tous les mots en majuscules et commençant par une majuscule, en ne prenant pas tous les autres en miniscule et commençant par une majuscule, garder un nombre compris entre 1 et 19, et garder une date sous ce format jj/mm/aaaa
Je suis un peu pris de cours, et ne sais pas comment m'en sortir.
Merci pour ton aide précieuse.