Transfert de cellule avec condition

[matrix]

Bonjour à tous,

J'aurais besoins d'aide sur une macro vba excel.

For n = 3 To Range("e65536").End(xlUp).Row
  x = Split(Range("e" & n), " ")
  Range("f" & n) = x(UBound(x) - 1)

  For m = 0 To UBound(x) - 4
    z = z & " " & x(m)
  Next m
 
Next n

Comme vous voyez, dans cette macro, il écrit dans la cellule de droite, les premiers caractères avant l'espace.

Voilà maintenant mon problème :
Je voudrais qu'il face la même chose, mais en plus, si les 3 premiers caractères du code postal est identique à plusieurs endroits dans la colonne E, dans ce cas la, il va vérifier les 3 prochains caractères et s'il y a une différence, il va transférer les 6 caractères au lieu de seulement 3.

Si par contre les 3 caractères suivants sont encore identiques, il inscrira que les 3 premiers caractères dans la cellule de droite.

Merci pour votre aide.

 

[Catrice]

Re : Transfert de cellule avec condition

Bonsoir,

ci-joint une solution :

Sub Test()
Set MaZone = Range("E3:" & Range("E65536").End(xlUp).Address)
For Each X In MaZone
X.Offset(0, 1) = Split(X, " ")(0)
Set c = MaZone.Find(Split(X, " ")(0))
firstAddress = c.Address
Do
If X.Value <> c.Value Then X.Offset(0, 1) = X: Exit Do
Set c = MaZone.FindNext(c)
Loop While c.Address <> firstAddress
Next
End Sub

Ton code précédent peut etre un peu raccourci :
Sub toto()
For Each X In Range("E3:" & Range("E65536").End(xlUp).Address)
X.Offset(0, 1) = Split(X, " ")(0)
Next
End Sub

 

[matrix]

Re : Transfert de cellule avec condition

Super merci, ça fonctionne tres bien.

🙂