Menu

Comparer la partie majuscule d'une cellule a la partie majuscule d'une autre cel

Messages postés
111
Date d'inscription
mercredi 18 avril 2018
Dernière intervention
21 mars 2019
- - Dernière réponse : blalaa
Messages postés
111
Date d'inscription
mercredi 18 avril 2018
Dernière intervention
21 mars 2019
- 14 mars 2019 à 14:14
bonjour

dans mon cas j'ai 2 cellule lesquelle je souhaite faire une comparaison entre eux

est il possible de comparer que une partie de conenu de cellul par rapport a lautre cellule ?

exemple

dans cellule a1 = LACORD Jerymy
dans la cellule b1 = Jerymy LACORD

on voit bien que les cellules contienent les mme prenom et nom mais nest pas ecrit de la mm maniere

je souhaite creer un code qui compare que les parties majuscules dans chque cellule

c v dire si la majuscule de la cellule A1 = la majuscule de la cellule B1 le code exécute

merci de me repondre
Afficher la suite 

Votre réponse

1 réponse

Messages postés
5899
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
21 mars 2019
410
0
Merci
Bonjour,

voir ceci pour extraire les majuscules d'une cellule:

https://www.commentcamarche.net/forum/affich-5401335-extraire-ls-majuscules-dans-une-cellule-excel

blalaa
Messages postés
111
Date d'inscription
mercredi 18 avril 2018
Dernière intervention
21 mars 2019
-
Jai essaye de l'adapter mais j'ai pas reussi voici le code que j'ai mis
je ne sais pas ou j'ai comis d'erreur

Sub chercher()
Dim nom As String
Dim prenom As String
Dim min As String
Dim nbre As Integer
Dim valeur As String

Set FL1 = Worksheets("Feuil1")
NoCol = 2 'lecture de la colonne B
For NoLig = 2 To 23

valeur = FL1.Cells(NoLig, NoCol)
nom = Split(Cells(NoLig, NoCol).Value, " ")(1)
prenom = Split(Cells(NoLig, NoCol).Value, " ")(0)

Cells(NoLig, NoCol).Value = Replace(Cells(NoLig, NoCol).Value, prenom, "")

min = majuscules(Cells(NoLig, NoCol))
nbre = Len(min)


Cells(NoLig, NoCol).Value = Replace(Cells(NoLig, NoCol).Value, prenom, "")

If nbre > 2 Then
Cells(NoLig, NoCol).Value = nom & " " & prenom
Else
Cells(NoLig, NoCol).Value = valeur
End If

Next
Set FL1 = Nothing
End Sub
Public Function majuscules(zone)
Dim sel As Object
Dim i As Integer
Application.Volatile
For Each sel In zone
For i = 1 To Len(sel)
If Asc(Mid(sel, i, 1)) > 64 And Asc(Mid(sel, i, 1)) < 91 Then
majuscules = majuscules & Mid(sel, i, 1)
End If
Next i
Next sel
End Function

cs_Le Pivert
Messages postés
5899
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
21 mars 2019
410 -
Il fallait faire une fonction à la place Private Sub chercher() en t'inspirant de Public Function majuscules(zone)

comme ceci:

Sub For_X_to_Next_Ligne()
Dim FL1 As Worksheet, NoCol As Integer
Dim maj As String
Dim NoLig As Long, Var As Variant
    Set FL1 = Worksheets("Feuil1")
    NoCol = 2 'lecture de la colonne B
    For NoLig = 2 To 23
        Var = FL1.Cells(NoLig, NoCol)
      chercher ("B" & NoLig)
    Next
    Set FL1 = Nothing
End Sub
Public Function chercher(zone)
Dim nom As String
Dim prenom As String
Dim min As String
Dim nbre As Integer
Dim valeur As String
valeur = Range(zone).Value
nom = Split(Range(zone).Value, " ")(1)
prenom = Split(Range(zone).Value, " ")(0)
Range(zone).Value = Replace(Range(zone).Value, prenom, "")
min = majuscules(Range(zone))
nbre = Len(min)
If nbre > 2 Then
Range(zone).Value = nom & " " & prenom
Else
Range(zone).Value = valeur
End If
End Function
Public Function majuscules(zone)
Dim sel As Object
Dim i As Integer
Application.Volatile
For Each sel In zone
For i = 1 To Len(sel)
If Asc(Mid(sel, i, 1)) > 64 And Asc(Mid(sel, i, 1)) < 91 Then
majuscules = majuscules & Mid(sel, i, 1)
End If
Next i
Next sel
End Function




Mais si tu ne fais que des copier coller, tu ne va pas progresser. Il faut chercher à comprendre le mécanisme.

Pour ce sujet tu as ouvert 4 post!

Bon courage essaie de trouver par toi même dans l'avenir

@+ Le Pivert
blalaa
Messages postés
111
Date d'inscription
mercredi 18 avril 2018
Dernière intervention
21 mars 2019
-
Merci beaucoupe pour votre aider en effet je suis completement perturbe je tacherais a lavenir de faire de mon mieux

merci encore
cs_Le Pivert
Messages postés
5899
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
21 mars 2019
410 -
J'ai changé colonne A par B dans le code
blalaa
Messages postés
111
Date d'inscription
mercredi 18 avril 2018
Dernière intervention
21 mars 2019
-
ok merci je prend note
Commenter la réponse de cs_Le Pivert