extraire chaîne de caractères (formule)

Function xcathy(r$)
xcathy = Split(Split(r, "@")(1), ".")(0)
End Function

Sub test()
Dim Email$, i As Byte
Email = "pascal.dupont@direction.finances.gouv.fr/pascal.dupont@finances.gouv.fr"
For i = 0 To 1
MsgBox xcathy(CStr(Split(Email, "/")(i)))
Next i
End Sub

Function RegMail(Chaine As Range) As String
Dim oRegExp, Match, Matches
Set oRegExp = CreateObject("vbscript.regexp")
With oRegExp
    .Global = True
   .Pattern = "^([\w\.\-]+@)([a-zA-Z0-9]+)(\.[a-zA-Z0-9\-]+)+$"
    Set Matches = .Execute(Chaine)
End With
RegMail = oRegExp.Replace(Chaine, "$2")
End Function

Function RegMail2(Chaine As Range, Rang As Integer) As String
Dim oRegExp, Match, Matches
Set oRegExp = CreateObject("vbscript.regexp")
With oRegExp
    .Global = True
    .Pattern = "^([a-zA-Z0-9_\.\-]+@)(([a-zA-Z0-9]+)(\.(([a-zA-Z0-9\-])+\.)+(com|org|net|gov|biz|info|name|aero|fr|be|co.uk|it|es|de|info)))+$"
    Set Matches = .Execute(Chaine)
End With
If Matches.Count = 0 Then
RegMail2 = "Adresse non valide"
ElseIf Rang - 1 < 2 Then RegMail2 = oRegExp.Replace(Chaine, "$" & Rang + 1)
End If
End Function

Public D1 As Date, D2 As Date, an As Integer
Sub CalculJoursOuvres()
D1 = DateSerial(2011, 12, 22)
D2 = DateSerial(2011, 12, 26)
Toto = NBJoursOuvres(D1, D2)
MsgBox Toto
End Sub

Function NBJoursOuvres(D1, D2)
Dim I As Long
an = Year(Date)
    For I = D1 To D2
         NBJoursOuvres = NBJoursOuvres + (Weekday(CDate(I)) <> 1 And _
                           Weekday(CDate(I)) <> 7) And CDate(I) <> Fer(an) * True
    Next
End Function

Function Paq(ByVal an As Integer) As Date
Paq = DateSerial(an, 3, 23) + ((2 * (an Mod 4) + (4 * (an Mod 7) + _
   (6 * (((19 * (an Mod 19)) + 24) Mod 30) + 5))) Mod 7) + _
   ((19 * (an Mod 19) + 24) Mod 30) - 1
End Function

Function Fer(an%) 'liste de tous les jours fériés
Dim pq
pq = Paq(an)
Fer = Array(CLng(DateSerial(an, 1, 1)), CLng(DateSerial(an, 5, 1)), CLng(DateSerial(an, 5, 8)), CLng(DateSerial(an, 7, 14)), CLng(DateSerial(an, 8, 15)), CLng(DateSerial(an, 11, 1)), CLng(DateSerial(an, 11, 11)), CLng(DateSerial(an, 12, 25)), CLng(pq) + 1, CLng(pq) + 39, CLng(pq) + 50)
End Function