Private Sub Worksheet_Change(ByVal Target As Range)
Dim a$(1 To 1000), t, n&, i&
'---tableau de correspondance à compléter---
a(1) = "Lyon"
a(2) = "Amiens"
a(3) = "Clermont"
a(20) = "Corse"
a(75) = "Paris"
a(77) = "Créteil"
a(78) = "Versailles"
a(91) = "Versailles"
a(92) = "Versailles"
a(93) = "Créteil"
a(94) = "Créteil"
a(95) = "Versailles"
a(971) = "Guadeloupe"
a(972) = "Martinique"
a(973) = "Guyane"
a(974) = "Réunion"
'---etc---
t = Me.UsedRange.Resize(, 4)
n = 1
On Error Resume Next 's'il n'y a pas de correspondance
For i = 2 To UBound(t)
If t(i, 1) <> "" Then
n = n + 1
t(n, 1) = t(i, 1)
t(n, 2) = IIf(Left(t(n, 1), 1) = 0, Mid(t(n, 1), 2, 2), Left(t(n, 1), 3))
t(n, 3) = ""
t(n, 3) = a(t(n, 2))
If t(n, 2) = "2A" Or t(n, 2) = "2B" Then t(n, 3) = a(20)
t(n, 4) = ""
If t(n, 3) <> "" Then t(n, 4) = "ce." & t(n, 1) & "@ac-" & t(n, 3) & ".fr"
t(n, 4) = LCase(Replace(t(n, 4), "é", "e"))
'---pour créer des liens hypertextes (facultatif)---
If t(n, 3) <> "" Then t(n, 4) = "=HYPERLINK(""" & t(n, 4) & """)"
End If
Next
Application.EnableEvents = False 'désactive les évènements
[A:A].NumberFormat = "@" 'format Texte
[B:B].NumberFormat = "00" 'affiche au moins 2 chiffres
[A1].Resize(n, 4) = t
Range("A" & n + 1 & ":D" & Rows.Count).Delete xlUp
Application.EnableEvents = True 'réactive les évènements
End Sub