Compare colonne et remplacer nom

Le
PST
Bonjour

J'essai de comparer deux colonnes.
Dans la deuxième colonne certains noms ne sont pas complets et
finisssent par des points

Donc j'enlève les points de la colonne B et je compare ce qui reste ave=
c
le même nombre de caractère de la colonne A

Cela fonctionne pour certains noms, pas pour d'autres
En comparant manuelement on dirait pourtant que c'est la même chose

merci


Sub Remplace_Noms()

Application.ScreenUpdating = False

Bd_1 = [A51].Row
Bd_2 = [B51].Row

For i = 1 To Bd_1
For j = 1 To Bd_2



t_1 = Cells(i, 1)
t_2 = Cells(j, 2)

t_2 = Replace(t_2, ".", "")

NB_Caract_BD_1 = Len(t_1)
NB_Caract_BD_2 = Len(t_2)

If Left(t_1, NB_Caract_BD_2) = Left(t_2, NB_Caract_BD_2) Then

Cells(i, 1).Offset(0, 5) = t_1 'Left(t_1, NB_Caract_BD_2)
Cells(i, 1).Offset(0, 6) = NB_Caract_BD_1
Cells(j, 2).Offset(0, 6) = t_2 'Left(t_2, NB_Caract_BD_2)
Cells(j, 2).Offset(0, 7) = NB_Caract_BD_2
Cells(i, 1).Font.ColorIndex = 30


Next
Next

Application.ScreenUpdating = True
End Sub
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
michdenis
Le #20913731
Bonjour,

La difficulté, c'est de savoir que si tu extrait le contenu
de la cellule en VBA, les "points" à la fin de la chaîne
ont la valeur 133 (Chr(133) et non Chr(46) lorsque l'on
type directement un point dans la fenêtre de code.

Je te dis... c'est des trucs à faire suer ....l'unicode ????

Voici un bout de code que tu dois adapter selon
le nom de ta feuille et la plage désignée.
Dans la colonne C:C, il est inscrit Vrai si le
début de la chaîne de caractère s'avère le même.

'-------------------------------
Sub test()
Dim Rg As Range, R As Range
Dim Texte As String
With Worksheets("Feuil1")
Set Rg = .Range("A1:B" & .Range("A65536").End(xlUp).Row)
End With

For Each R In Rg.Rows
For Each c In R.Columns(1).Cells
If InStr(1, c(1, 1).Text, Replace(c(1, 2).Text, _
Chr(133), ""), vbTextCompare) > 0 Then
c.Offset(, 2) = True
End If
Next
Next
End Sub
'-------------------------------




"PST" 4b44bbe7$0$17500$
Bonjour

J'essai de comparer deux colonnes.
Dans la deuxième colonne certains noms ne sont pas complets et
finisssent par des points

Donc j'enlève les points de la colonne B et je compare ce qui reste avec
le même nombre de caractère de la colonne A

Cela fonctionne pour certains noms, pas pour d'autres
En comparant manuelement on dirait pourtant que c'est la même chose

merci


Sub Remplace_Noms()

Application.ScreenUpdating = False

Bd_1 = [A51].Row
Bd_2 = [B51].Row

For i = 1 To Bd_1
For j = 1 To Bd_2



t_1 = Cells(i, 1)
t_2 = Cells(j, 2)

t_2 = Replace(t_2, ".", "")

NB_Caract_BD_1 = Len(t_1)
NB_Caract_BD_2 = Len(t_2)

If Left(t_1, NB_Caract_BD_2) = Left(t_2, NB_Caract_BD_2) Then

Cells(i, 1).Offset(0, 5) = t_1 'Left(t_1, NB_Caract_BD_2)
Cells(i, 1).Offset(0, 6) = NB_Caract_BD_1
Cells(j, 2).Offset(0, 6) = t_2 'Left(t_2, NB_Caract_BD_2)
Cells(j, 2).Offset(0, 7) = NB_Caract_BD_2
Cells(i, 1).Font.ColorIndex = 30


Next
Next

Application.ScreenUpdating = True
End Sub
michdenis
Le #20914281
J'apporte une légère correction au code soumis :

Dans tes cellules, si la chaîne de caractères se termine par
3 points donc un point de suspension, le caractère Ascii est 133
lorsque l'on demande de remplacer les "points" par "", s'il y a
plus de 3 points, il faut enlever le (les) points de suspension et
on ajoute une ligne pour enlever le caractère "." Comme ça
on peut comparer (vérifier) si la chaine de caractères en colonne B
est présente dans la chaine en colonne A. Pour effectuer cette
comparaison, on peut utiliser autre chose que Instr(), cela dépend
des exigences de l'application.

'------------------------------------
Sub test()
Dim Rg As Range, R As Range, C As Range
Dim T As String
With Worksheets("Feuil1")
Set Rg = .Range("A1:B" & .Range("A65536").End(xlUp).Row)
End With

For Each R In Rg.Rows
For Each C In R.Columns(1).Cells
T = Replace(C(1, 2).Text, Chr(133), "")
T = Replace(T, Chr(46), "")
If InStr(1, C, T, vbTextCompare) > 0 Then
C.Offset(, 2) = True
End If
Next
Next
End Sub
'------------------------------------



"michdenis"
Bonjour,

La difficulté, c'est de savoir que si tu extrait le contenu
de la cellule en VBA, les "points" à la fin de la chaîne
ont la valeur 133 (Chr(133) et non Chr(46) lorsque l'on
type directement un point dans la fenêtre de code.

Je te dis... c'est des trucs à faire suer ....l'unicode ????

Voici un bout de code que tu dois adapter selon
le nom de ta feuille et la plage désignée.
Dans la colonne C:C, il est inscrit Vrai si le
début de la chaîne de caractère s'avère le même.

'-------------------------------
Sub test()
Dim Rg As Range, R As Range
Dim Texte As String
With Worksheets("Feuil1")
Set Rg = .Range("A1:B" & .Range("A65536").End(xlUp).Row)
End With

For Each R In Rg.Rows
For Each c In R.Columns(1).Cells
If InStr(1, c(1, 1).Text, Replace(c(1, 2).Text, _
Chr(133), ""), vbTextCompare) > 0 Then
c.Offset(, 2) = True
End If
Next
Next
End Sub
'-------------------------------




"PST" 4b44bbe7$0$17500$
Bonjour

J'essai de comparer deux colonnes.
Dans la deuxième colonne certains noms ne sont pas complets et
finisssent par des points

Donc j'enlève les points de la colonne B et je compare ce qui reste avec
le même nombre de caractère de la colonne A

Cela fonctionne pour certains noms, pas pour d'autres
En comparant manuelement on dirait pourtant que c'est la même chose

merci


Sub Remplace_Noms()

Application.ScreenUpdating = False

Bd_1 = [A51].Row
Bd_2 = [B51].Row

For i = 1 To Bd_1
For j = 1 To Bd_2



t_1 = Cells(i, 1)
t_2 = Cells(j, 2)

t_2 = Replace(t_2, ".", "")

NB_Caract_BD_1 = Len(t_1)
NB_Caract_BD_2 = Len(t_2)

If Left(t_1, NB_Caract_BD_2) = Left(t_2, NB_Caract_BD_2) Then

Cells(i, 1).Offset(0, 5) = t_1 'Left(t_1, NB_Caract_BD_2)
Cells(i, 1).Offset(0, 6) = NB_Caract_BD_1
Cells(j, 2).Offset(0, 6) = t_2 'Left(t_2, NB_Caract_BD_2)
Cells(j, 2).Offset(0, 7) = NB_Caract_BD_2
Cells(i, 1).Font.ColorIndex = 30


Next
Next

Application.ScreenUpdating = True
End Sub
michdenis
Le #20917821
Donne quelques exemples du contenu de la
cellule en A, en B, et ce que tu veux avoir en C



"PST" 4b45a1e0$0$933$
Merci pour la réponse

La macro test complete dans la colonne C ce qui mangue à la colonne A

Ce que je voudrais comparer la colonne A avec la B tout ce qui est
commun dans la c

La macro que j'ai fait me donne ce que je veux sauf que ça enlève les
points partout, ce qui me donne des erreurs alors qu'il faut enlever
seulement sur la fin du nom, 3 derniers caractères.


Les points sont chr(46)




Le 06/01/2010 21:16, michdenis a écrit :
J'apporte une légère correction au code soumis :

Dans tes cellules, si la chaîne de caractères se termine par
3 points donc un point de suspension, le caractère Ascii est 133
lorsque l'on demande de remplacer les "points" par "", s'il y a
plus de 3 points, il faut enlever le (les) points de suspension et
on ajoute une ligne pour enlever le caractère "." Comme ça
on peut comparer (vérifier) si la chaine de caractères en colonne B
est présente dans la chaine en colonne A. Pour effectuer cette
comparaison, on peut utiliser autre chose que Instr(), cela dépend
des exigences de l'application.

'------------------------------------
Sub test()
Dim Rg As Range, R As Range, C As Range
Dim T As String
With Worksheets("Feuil1")
Set Rg = .Range("A1:B"& .Range("A65536").End(xlUp).Row)
End With

For Each R In Rg.Rows
For Each C In R.Columns(1).Cells
T = Replace(C(1, 2).Text, Chr(133), "")
T = Replace(T, Chr(46), "")
If InStr(1, C, T, vbTextCompare)> 0 Then
C.Offset(, 2) = True
End If
Next
Next
End Sub
'------------------------------------



"michdenis"
Bonjour,

La difficulté, c'est de savoir que si tu extrait le contenu
de la cellule en VBA, les "points" à la fin de la chaîne
ont la valeur 133 (Chr(133) et non Chr(46) lorsque l'on
type directement un point dans la fenêtre de code.

Je te dis... c'est des trucs à faire suer ....l'unicode ????

Voici un bout de code que tu dois adapter selon
le nom de ta feuille et la plage désignée.
Dans la colonne C:C, il est inscrit Vrai si le
début de la chaîne de caractère s'avère le même.

'-------------------------------
Sub test()
Dim Rg As Range, R As Range
Dim Texte As String
With Worksheets("Feuil1")
Set Rg = .Range("A1:B"& .Range("A65536").End(xlUp).Row)
End With

For Each R In Rg.Rows
For Each c In R.Columns(1).Cells
If InStr(1, c(1, 1).Text, Replace(c(1, 2).Text, _
Chr(133), ""), vbTextCompare)> 0 Then
c.Offset(, 2) = True
End If
Next
Next
End Sub
'-------------------------------




"PST" 4b44bbe7$0$17500$
Bonjour

J'essai de comparer deux colonnes.
Dans la deuxième colonne certains noms ne sont pas complets et
finisssent par des points

Donc j'enlève les points de la colonne B et je compare ce qui reste avec
le même nombre de caractère de la colonne A

Cela fonctionne pour certains noms, pas pour d'autres
En comparant manuelement on dirait pourtant que c'est la même chose

merci


Sub Remplace_Noms()

Application.ScreenUpdating = False

Bd_1 = [A51].Row
Bd_2 = [B51].Row

For i = 1 To Bd_1
For j = 1 To Bd_2



t_1 = Cells(i, 1)
t_2 = Cells(j, 2)

t_2 = Replace(t_2, ".", "")

NB_Caract_BD_1 = Len(t_1)
NB_Caract_BD_2 = Len(t_2)

If Left(t_1, NB_Caract_BD_2) = Left(t_2, NB_Caract_BD_2) Then

Cells(i, 1).Offset(0, 5) = t_1 'Left(t_1, NB_Caract_BD_2)
Cells(i, 1).Offset(0, 6) = NB_Caract_BD_1
Cells(j, 2).Offset(0, 6) = t_2 'Left(t_2, NB_Caract_BD_2)
Cells(j, 2).Offset(0, 7) = NB_Caract_BD_2
Cells(i, 1).Font.ColorIndex = 30


Next
Next

Application.ScreenUpdating = True
End Sub



PST
Le #20917041
Merci pour la réponse

La macro test complete dans la colonne C ce qui mangue à la colonne A

Ce que je voudrais comparer la colonne A avec la B tout ce qui est
commun dans la c

La macro que j'ai fait me donne ce que je veux sauf que ça enlève les
points partout, ce qui me donne des erreurs alors qu'il faut enlever
seulement sur la fin du nom, 3 derniers caractères.


Les points sont chr(46)




Le 06/01/2010 21:16, michdenis a écrit :
J'apporte une légère correction au code soumis :

Dans tes cellules, si la chaîne de caractères se termine par
3 points donc un point de suspension, le caractère Ascii est 133
lorsque l'on demande de remplacer les "points" par "", s'il y a
plus de 3 points, il faut enlever le (les) points de suspension et
on ajoute une ligne pour enlever le caractère "." Comme ça
on peut comparer (vérifier) si la chaine de caractères en colonne B
est présente dans la chaine en colonne A. Pour effectuer cette
comparaison, on peut utiliser autre chose que Instr(), cela dépend
des exigences de l'application.

'------------------------------------
Sub test()
Dim Rg As Range, R As Range, C As Range
Dim T As String
With Worksheets("Feuil1")
Set Rg = .Range("A1:B"& .Range("A65536").End(xlUp).Row)
End With

For Each R In Rg.Rows
For Each C In R.Columns(1).Cells
T = Replace(C(1, 2).Text, Chr(133), "")
T = Replace(T, Chr(46), "")
If InStr(1, C, T, vbTextCompare)> 0 Then
C.Offset(, 2) = True
End If
Next
Next
End Sub
'------------------------------------



"michdenis"
Bonjour,

La difficulté, c'est de savoir que si tu extrait le contenu
de la cellule en VBA, les "points" à la fin de la chaîne
ont la valeur 133 (Chr(133) et non Chr(46) lorsque l'on
type directement un point dans la fenêtre de code.

Je te dis... c'est des trucs à faire suer ....l'unicode ????

Voici un bout de code que tu dois adapter selon
le nom de ta feuille et la plage désignée.
Dans la colonne C:C, il est inscrit Vrai si le
début de la chaîne de caractère s'avère le même.

'-------------------------------
Sub test()
Dim Rg As Range, R As Range
Dim Texte As String
With Worksheets("Feuil1")
Set Rg = .Range("A1:B"& .Range("A65536").End(xlUp).Row)
End With

For Each R In Rg.Rows
For Each c In R.Columns(1).Cells
If InStr(1, c(1, 1).Text, Replace(c(1, 2).Text, _
Chr(133), ""), vbTextCompare)> 0 Then
c.Offset(, 2) = True
End If
Next
Next
End Sub
'-------------------------------




"PST" 4b44bbe7$0$17500$
Bonjour

J'essai de comparer deux colonnes.
Dans la deuxième colonne certains noms ne sont pas complets et
finisssent par des points

Donc j'enlève les points de la colonne B et je compare ce qui reste a vec
le même nombre de caractère de la colonne A

Cela fonctionne pour certains noms, pas pour d'autres
En comparant manuelement on dirait pourtant que c'est la même chose

merci


Sub Remplace_Noms()

Application.ScreenUpdating = False

Bd_1 = [A51].Row
Bd_2 = [B51].Row

For i = 1 To Bd_1
For j = 1 To Bd_2



t_1 = Cells(i, 1)
t_2 = Cells(j, 2)

t_2 = Replace(t_2, ".", "")

NB_Caract_BD_1 = Len(t_1)
NB_Caract_BD_2 = Len(t_2)

If Left(t_1, NB_Caract_BD_2) = Left(t_2, NB_Caract_BD_2) Then

Cells(i, 1).Offset(0, 5) = t_1 'Left(t_1, NB_Caract_BD_2)
Cells(i, 1).Offset(0, 6) = NB_Caract_BD_1
Cells(j, 2).Offset(0, 6) = t_2 'Left(t_2, NB_Caract_BD_2)
Cells(j, 2).Offset(0, 7) = NB_Caract_BD_2
Cells(i, 1).Font.ColorIndex = 30


Next
Next

Application.ScreenUpdating = True
End Sub



michdenis
Le #20918961
Suppose que la chaîne en A est différente
de celle en B, que doit-il se passer ?
Exemple :
En A En B
C.T.B.A C.T .B.A
En B, il y a un espace ou un mot de plus qu'en A

Autre cas :
que se passe-t-il si après les point de suspension en b il
y a un autre mot qui n'apparaît pas en A ?

La procédure qui suit répond aux 2 cas précédents de figure
en inscrivant rien en C

'--------------------------------------
Sub test()
Dim Rg As Range, R As Range, C As Range
Dim T As String
With Worksheets("Feuil2") 'Nom feuille à adapter
Set Rg = .Range("A1:B" & .Range("A65536").End(xlUp).Row)
End With

For Each R In Rg.Rows
For Each C In R.Columns(1).Cells
T = Replace(C(1, 2).Text, Chr(133), "")
T = Replace(T, Chr(46), "")
If C.Value Like T Then
C.Offset(, 2) = C.Value
ElseIf InStr(1, C(1, 1), T, vbTextCompare) > 0 Then
C.Offset(, 2) = C.Value
End If
Next
Next
End Sub
'--------------------------------------




"PST" 4b45e44e$0$931$
Dans la colonne C affichage de la phrase complète si commun A et B

Je pense qu'il n'y a que trois cas:

>>>La phrase est complète>>Elle appartient à A et à B donc commun= col C

>>>La phrase est imcomplète et se termine par des points :
-Enlever les points en fin de ligne
-Vérifier la chaine de caractère restante avec la même chaine de
caractère de la colonne A
-Si la chaine est présente, afficher la chaine A (le mot
complet)dans la colonne C

>>> La phrase contient des points qui ne sont pas en fin de ligne :
si c'est la même phrase commun A don colonne C


Ex:
colonne A:
Le temps est à l'orage
Le temps est pluvieux ce matin
C.T.B.A

Colonne B:
Le temps est à l'orage
Le temps est pluvieux ce m...
C.T.B.A

Colonne C:
Le temps est à l'orage
Le temps est pluvieux ce matin
C.T.B.A


Le 07/01/2010 11:48, michdenis a écrit :
Donne quelques exemples du contenu de la
cellule en A, en B, et ce que tu veux avoir en C



"PST" 4b45a1e0$0$933$
Merci pour la réponse

La macro test complete dans la colonne C ce qui mangue à la colonne A

Ce que je voudrais comparer la colonne A avec la B tout ce qui est
commun dans la c

La macro que j'ai fait me donne ce que je veux sauf que ça enlève les
points partout, ce qui me donne des erreurs alors qu'il faut enlever
seulement sur la fin du nom, 3 derniers caractères.


Les points sont chr(46)




Le 06/01/2010 21:16, michdenis a écrit :
J'apporte une légère correction au code soumis :

Dans tes cellules, si la chaîne de caractères se termine par
3 points donc un point de suspension, le caractère Ascii est 133
lorsque l'on demande de remplacer les "points" par "", s'il y a
plus de 3 points, il faut enlever le (les) points de suspension et
on ajoute une ligne pour enlever le caractère "." Comme ça
on peut comparer (vérifier) si la chaine de caractères en colonne B
est présente dans la chaine en colonne A. Pour effectuer cette
comparaison, on peut utiliser autre chose que Instr(), cela dépend
des exigences de l'application.

'------------------------------------
Sub test()
Dim Rg As Range, R As Range, C As Range
Dim T As String
With Worksheets("Feuil1")
Set Rg = .Range("A1:B"& .Range("A65536").End(xlUp).Row)
End With

For Each R In Rg.Rows
For Each C In R.Columns(1).Cells
T = Replace(C(1, 2).Text, Chr(133), "")
T = Replace(T, Chr(46), "")
If InStr(1, C, T, vbTextCompare)> 0 Then
C.Offset(, 2) = True
End If
Next
Next
End Sub
'------------------------------------



"michdenis"
Bonjour,

La difficulté, c'est de savoir que si tu extrait le contenu
de la cellule en VBA, les "points" à la fin de la chaîne
ont la valeur 133 (Chr(133) et non Chr(46) lorsque l'on
type directement un point dans la fenêtre de code.

Je te dis... c'est des trucs à faire suer ....l'unicode ????

Voici un bout de code que tu dois adapter selon
le nom de ta feuille et la plage désignée.
Dans la colonne C:C, il est inscrit Vrai si le
début de la chaîne de caractère s'avère le même.

'-------------------------------
Sub test()
Dim Rg As Range, R As Range
Dim Texte As String
With Worksheets("Feuil1")
Set Rg = .Range("A1:B"& .Range("A65536").End(xlUp).Row)
End With

For Each R In Rg.Rows
For Each c In R.Columns(1).Cells
If InStr(1, c(1, 1).Text, Replace(c(1, 2).Text, _
Chr(133), ""), vbTextCompare)> 0 Then
c.Offset(, 2) = True
End If
Next
Next
End Sub
'-------------------------------




"PST" 4b44bbe7$0$17500$
Bonjour

J'essai de comparer deux colonnes.
Dans la deuxième colonne certains noms ne sont pas complets et
finisssent par des points

Donc j'enlève les points de la colonne B et je compare ce qui reste avec
le même nombre de caractère de la colonne A

Cela fonctionne pour certains noms, pas pour d'autres
En comparant manuelement on dirait pourtant que c'est la même chose

merci


Sub Remplace_Noms()

Application.ScreenUpdating = False

Bd_1 = [A51].Row
Bd_2 = [B51].Row

For i = 1 To Bd_1
For j = 1 To Bd_2



t_1 = Cells(i, 1)
t_2 = Cells(j, 2)

t_2 = Replace(t_2, ".", "")

NB_Caract_BD_1 = Len(t_1)
NB_Caract_BD_2 = Len(t_2)

If Left(t_1, NB_Caract_BD_2) = Left(t_2, NB_Caract_BD_2) Then

Cells(i, 1).Offset(0, 5) = t_1 'Left(t_1, NB_Caract_BD_2)
Cells(i, 1).Offset(0, 6) = NB_Caract_BD_1
Cells(j, 2).Offset(0, 6) = t_2 'Left(t_2, NB_Caract_BD_2)
Cells(j, 2).Offset(0, 7) = NB_Caract_BD_2
Cells(i, 1).Font.ColorIndex = 30


Next
Next

Application.ScreenUpdating = True
End Sub





michdenis
Le #20919801
| je me limite aux cités dans l(autre poste

Je suppose alors que ma procédure doit faire un tabac !
PST
Le #20918721
Dans la colonne C affichage de la phrase complète si commun A et B

Je pense qu'il n'y a que trois cas:

>>>La phrase est complète>>Elle appartient à A et à B donc commun= col C

>>>La phrase est imcomplète et se termine par des points :
-Enlever les points en fin de ligne
-Vérifier la chaine de caractère restante avec la même chaine de
caractère de la colonne A
-Si la chaine est présente, afficher la chaine A (le mot
complet)dans la colonne C

>>> La phrase contient des points qui ne sont pas en fin de ligne :
si c'est la même phrase commun A don colonne C


Ex:
colonne A:
Le temps est à l'orage
Le temps est pluvieux ce matin
C.T.B.A

Colonne B:
Le temps est à l'orage
Le temps est pluvieux ce m...
C.T.B.A

Colonne C:
Le temps est à l'orage
Le temps est pluvieux ce matin
C.T.B.A


Le 07/01/2010 11:48, michdenis a écrit :
Donne quelques exemples du contenu de la
cellule en A, en B, et ce que tu veux avoir en C



"PST" 4b45a1e0$0$933$
Merci pour la réponse

La macro test complete dans la colonne C ce qui mangue à la colonne A

Ce que je voudrais comparer la colonne A avec la B tout ce qui est
commun dans la c

La macro que j'ai fait me donne ce que je veux sauf que ça enlève l es
points partout, ce qui me donne des erreurs alors qu'il faut enlever
seulement sur la fin du nom, 3 derniers caractères.


Les points sont chr(46)




Le 06/01/2010 21:16, michdenis a écrit :
J'apporte une légère correction au code soumis :

Dans tes cellules, si la chaîne de caractères se termine par
3 points donc un point de suspension, le caractère Ascii est 133
lorsque l'on demande de remplacer les "points" par "", s'il y a
plus de 3 points, il faut enlever le (les) points de suspension et
on ajoute une ligne pour enlever le caractère "." Comme ça
on peut comparer (vérifier) si la chaine de caractères en colonne B
est présente dans la chaine en colonne A. Pour effectuer cette
comparaison, on peut utiliser autre chose que Instr(), cela dépend
des exigences de l'application.

'------------------------------------
Sub test()
Dim Rg As Range, R As Range, C As Range
Dim T As String
With Worksheets("Feuil1")
Set Rg = .Range("A1:B"& .Range("A65536").End(xlUp).Row)
End With

For Each R In Rg.Rows
For Each C In R.Columns(1).Cells
T = Replace(C(1, 2).Text, Chr(133), "")
T = Replace(T, Chr(46), "")
If InStr(1, C, T, vbTextCompare)> 0 Then
C.Offset(, 2) = True
End If
Next
Next
End Sub
'------------------------------------



"michdenis"
Bonjour,

La difficulté, c'est de savoir que si tu extrait le contenu
de la cellule en VBA, les "points" à la fin de la chaîne
ont la valeur 133 (Chr(133) et non Chr(46) lorsque l'on
type directement un point dans la fenêtre de code.

Je te dis... c'est des trucs à faire suer ....l'unicode ????

Voici un bout de code que tu dois adapter selon
le nom de ta feuille et la plage désignée.
Dans la colonne C:C, il est inscrit Vrai si le
début de la chaîne de caractère s'avère le même.

'-------------------------------
Sub test()
Dim Rg As Range, R As Range
Dim Texte As String
With Worksheets("Feuil1")
Set Rg = .Range("A1:B"& .Range("A65536").End(xlUp).Row)
End With

For Each R In Rg.Rows
For Each c In R.Columns(1).Cells
If InStr(1, c(1, 1).Text, Replace(c(1, 2).Text, _
Chr(133), ""), vbTextCompare)> 0 Then
c.Offset(, 2) = True
End If
Next
Next
End Sub
'-------------------------------




"PST" 4b44bbe7$0$17500$
Bonjour

J'essai de comparer deux colonnes.
Dans la deuxième colonne certains noms ne sont pas complets et
finisssent par des points

Donc j'enlève les points de la colonne B et je compare ce qui reste avec
le même nombre de caractère de la colonne A

Cela fonctionne pour certains noms, pas pour d'autres
En comparant manuelement on dirait pourtant que c'est la même chose

merci


Sub Remplace_Noms()

Application.ScreenUpdating = False

Bd_1 = [A51].Row
Bd_2 = [B51].Row

For i = 1 To Bd_1
For j = 1 To Bd_2



t_1 = Cells(i, 1)
t_2 = Cells(j, 2)

t_2 = Replace(t_2, ".", "")

NB_Caract_BD_1 = Len(t_1)
NB_Caract_BD_2 = Len(t_2)

If Left(t_1, NB_Caract_BD_2) = Left(t_2, NB_Caract_BD_2) Then

Cells(i, 1).Offset(0, 5) = t_1 'Left(t_1, NB_Caract_BD_2)
Cells(i, 1).Offset(0, 6) = NB_Caract_BD_1
Cells(j, 2).Offset(0, 6) = t_2 'Left(t_2, NB_Caract_BD_2)
Cells(j, 2).Offset(0, 7) = NB_Caract_BD_2
Cells(i, 1).Font.ColorIndex = 30


Next
Next

Application.ScreenUpdating = True
End Sub





PST
Le #20919641
Ce n'est que la fin des phrases qui est tronquée
Le début de la phrase jusqu'au trois point est la même
Pas de mots après les trois points qui sont là pour écourter la phr ase

je me limite aux cités dans l(autre poste

Le 07/01/2010 15:12, michdenis a écrit :
Suppose que la chaîne en A est différente
de celle en B, que doit-il se passer ?
Exemple :
En A En B
C.T.B.A C.T .B.A
En B, il y a un espace ou un mot de plus qu'en A

Autre cas :
que se passe-t-il si après les point de suspension en b il
y a un autre mot qui n'apparaît pas en A ?

La procédure qui suit répond aux 2 cas précédents de figure
en inscrivant rien en C

'--------------------------------------
Sub test()
Dim Rg As Range, R As Range, C As Range
Dim T As String
With Worksheets("Feuil2") 'Nom feuille à adapter
Set Rg = .Range("A1:B"& .Range("A65536").End(xlUp).Row)
End With

For Each R In Rg.Rows
For Each C In R.Columns(1).Cells
T = Replace(C(1, 2).Text, Chr(133), "")
T = Replace(T, Chr(46), "")
If C.Value Like T Then
C.Offset(, 2) = C.Value
ElseIf InStr(1, C(1, 1), T, vbTextCompare)> 0 Then
C.Offset(, 2) = C.Value
End If
Next
Next
End Sub
'--------------------------------------




"PST" 4b45e44e$0$931$
Dans la colonne C affichage de la phrase complète si commun A et B

Je pense qu'il n'y a que trois cas:

>>>La phrase est complète>>Elle appartient à A et à B donc comm un= col C

>>>La phrase est imcomplète et se termine par des points :
-Enlever les points en fin de ligne
-Vérifier la chaine de caractère restante avec la même chain e de
caractère de la colonne A
-Si la chaine est présente, afficher la chaine A (le mot
complet)dans la colonne C

>>> La phrase contient des points qui ne sont pas en fin de ligne :
si c'est la même phrase commun A don colonne C


Ex:
colonne A:
Le temps est à l'orage
Le temps est pluvieux ce matin
C.T.B.A

Colonne B:
Le temps est à l'orage
Le temps est pluvieux ce m...
C.T.B.A

Colonne C:
Le temps est à l'orage
Le temps est pluvieux ce matin
C.T.B.A


Le 07/01/2010 11:48, michdenis a écrit :
Donne quelques exemples du contenu de la
cellule en A, en B, et ce que tu veux avoir en C



"PST" 4b45a1e0$0$933$
Merci pour la réponse

La macro test complete dans la colonne C ce qui mangue à la colonne A

Ce que je voudrais comparer la colonne A avec la B tout ce qui est
commun dans la c

La macro que j'ai fait me donne ce que je veux sauf que ça enlève les
points partout, ce qui me donne des erreurs alors qu'il faut enlever
seulement sur la fin du nom, 3 derniers caractères.


Les points sont chr(46)




Le 06/01/2010 21:16, michdenis a écrit :
J'apporte une légère correction au code soumis :

Dans tes cellules, si la chaîne de caractères se termine par
3 points donc un point de suspension, le caractère Ascii est 133
lorsque l'on demande de remplacer les "points" par "", s'il y a
plus de 3 points, il faut enlever le (les) points de suspension et
on ajoute une ligne pour enlever le caractère "." Comme ça
on peut comparer (vérifier) si la chaine de caractères en colonne B
est présente dans la chaine en colonne A. Pour effectuer cette
comparaison, on peut utiliser autre chose que Instr(), cela dépend
des exigences de l'application.

'------------------------------------
Sub test()
Dim Rg As Range, R As Range, C As Range
Dim T As String
With Worksheets("Feuil1")
Set Rg = .Range("A1:B"& .Range("A65536").End(xlUp).Row)
End With

For Each R In Rg.Rows
For Each C In R.Columns(1).Cells
T = Replace(C(1, 2).Text, Chr(133), "")
T = Replace(T, Chr(46), "")
If InStr(1, C, T, vbTextCompare)> 0 Then
C.Offset(, 2) = True
End If
Next
Next
End Sub
'------------------------------------



"michdenis"
Bonjour,

La difficulté, c'est de savoir que si tu extrait le contenu
de la cellule en VBA, les "points" à la fin de la chaîne
ont la valeur 133 (Chr(133) et non Chr(46) lorsque l'on
type directement un point dans la fenêtre de code.

Je te dis... c'est des trucs à faire suer ....l'unicode ????

Voici un bout de code que tu dois adapter selon
le nom de ta feuille et la plage désignée.
Dans la colonne C:C, il est inscrit Vrai si le
début de la chaîne de caractère s'avère le même.

'-------------------------------
Sub test()
Dim Rg As Range, R As Range
Dim Texte As String
With Worksheets("Feuil1")
Set Rg = .Range("A1:B"& .Range("A65536").End(xlUp).Row)
End With

For Each R In Rg.Rows
For Each c In R.Columns(1).Cells
If InStr(1, c(1, 1).Text, Replace(c(1, 2).Text, _
Chr(133), ""), vbTextCompare)> 0 Then
c.Offset(, 2) = True
End If
Next
Next
End Sub
'-------------------------------




"PST" 4b44bbe7$0$17500$
Bonjour

J'essai de comparer deux colonnes.
Dans la deuxième colonne certains noms ne sont pas complets et
finisssent par des points

Donc j'enlève les points de la colonne B et je compare ce qui reste avec
le même nombre de caractère de la colonne A

Cela fonctionne pour certains noms, pas pour d'autres
En comparant manuelement on dirait pourtant que c'est la même chose

merci


Sub Remplace_Noms()

Application.ScreenUpdating = False

Bd_1 = [A51].Row
Bd_2 = [B51].Row

For i = 1 To Bd_1
For j = 1 To Bd_2



t_1 = Cells(i, 1)
t_2 = Cells(j, 2)

t_2 = Replace(t_2, ".", "")

NB_Caract_BD_1 = Len(t_1)
NB_Caract_BD_2 = Len(t_2)

If Left(t_1, NB_Caract_BD_2) = Left(t_2, NB_Caract_BD_2) Then

Cells(i, 1).Offset(0, 5) = t_1 'Left(t_1, NB_Caract_BD_2)
Cells(i, 1).Offset(0, 6) = NB_Caract_BD_1
Cells(j, 2).Offset(0, 6) = t_2 'Left(t_2, NB_Caract_BD_2)
Cells(j, 2).Offset(0, 7) = NB_Caract_BD_2
Cells(i, 1).Font.ColorIndex = 30


Next
Next

Application.ScreenUpdating = True
End Sub







Publicité
Poster une réponse
Anonyme