Sub Repartir()
Dim Cel As Range
Dim Tbl() As Double
Dim Texte As String
Dim Annee As String
Dim Pos As Integer
Dim I As Integer
Dim J As Integer
'la cellule à répartir est A5
Set Cel = Range("A5")
'recherche l'année (enfin je suppose que c'est ce qu représente 2012 ?
Pos = InStr(Cel, "2012")
'stocke l'année
Annee = Mid(Cel, Pos, 4)
'récupère les valeurs à répartir sans l'année
Texte = Right(Cel, Len(Cel) - Pos - 3)
'point de départ
Pos = 1
'boucle sur le texte à la recherche des virgules
'et stocke les valeurs dans un tableau
For I = 1 To Len(Texte)
If Mid(Texte, I, 1) = "," Then
J = J + 1
ReDim Preserve Tbl(1 To J)
Tbl(J) = Mid(Texte, Pos, I - Pos + 3)
Pos = I + 3
End If
Next I
'l'année en ligne 2 et colonne 2 soit en "B2"
Cells(2, 2) = Annee
'inscrit les différentes valeurs dans les colonnes de la ligne 2
For I = 1 To UBound(Tbl)
Cells(2, I + 2) = Format(Tbl(I), "#.00")
Next I
End Sub
Function Extraire_num(chaine As String, Rang As Integer) As String
Dim oRegExp As Object, Matches As Object
Set oRegExp = CreateObject("vbscript.regexp")
If chaine = "" Then Exit Function
With oRegExp
.Global = True
.Pattern = "[^\d,]"
If .test(chaine) = True Then chaine = Application.WorksheetFunction.Trim(.Replace(chaine, " "))
.Pattern = "(.*" & Year(Date) & ")(.*)"
If .test(chaine) = True Then chaine = .Replace(chaine, "$2")
.Pattern = "(\d+,\d\d)"
If .test(chaine) = True Then
Set Matches = .Execute(chaine)
If Rang - 1 < Matches.Count Then Extraire_num = Matches(Rang - 1)
End If
Set oRegExp = Nothing
End With
End Function
=SUBSTITUE(STXT("/"&SUBSTITUE(", "&STXT(SUPPRESPACE($A5);CHERCHE(ANNEE(AUJOURDHUI());SUPPRESPACE($A5))+4;NBCAR(SUPPRESPACE($A5)))&",";",";"/")&"/";CHERCHE("/";SUBSTITUE(" "&", "&STXT(SUPPRESPACE($A5);CHERCHE(ANNEE(AUJOURDHUI());SUPPRESPACE($A5))+4;NBCAR(SUPPRESPACE($A5)))&","&" ";",";"/";COLONNES($A:A)))+3;CHERCHE("/";SUBSTITUE(" "&", "&STXT(SUPPRESPACE($A5);CHERCHE(ANNEE(AUJOURDHUI());SUPPRESPACE($A5))+4;NBCAR(SUPPRESPACE($A5)))&","&" ";",";"/";COLONNES($A:B)))-CHERCHE("/";SUBSTITUE(" "&", "&STXT(SUPPRESPACE($A5);CHERCHE(ANNEE(AUJOURDHUI());SUPPRESPACE($A5))+4;NBCAR(SUPPRESPACE($A5)))&","&" ";",";"/";COLONNES($A:A))));"/";",")
Function Extraire_num(chaine As String, Rang As Integer) As String
Dim oRegExp As Object, Matches As Object
Set oRegExp = CreateObject("vbscript.regexp")
If chaine = "" Then Exit Function
With oRegExp
.Global = True
.Pattern = "(.*" & Year(Date) & ")(.*)"
If .test(chaine) = True Then chaine = Application.WorksheetFunction.Trim(.Replace(chaine, "$2"))
.Pattern = "(\d+,\d\d)"
If .test(chaine) = True Then
Set Matches = .Execute(chaine)
If Rang - 1 < Matches.Count Then Extraire_num = Matches(Rang - 1)
End If
Set oRegExp = Nothing
End With
End Function
=STXT(","&SUBSTITUE(STXT($A5;CHERCHE(ANNEE(AUJOURDHUI());$A5)+4;NBCAR($A5));",";",");CHERCHE("/";SUBSTITUE( ", "&STXT($A5;CHERCHE(ANNEE(AUJOURDHUI());$A5)+4;NBCAR($A5));",";"/";COLONNES($A:A)))+1;CHERCHE("/";SUBSTITUE(","&STXT($A5;CHERCHE(ANNEE(AUJOURDHUI());$A5)+4;NBCAR($A5));",";"/";COLONNES($A:B)))-CHERCHE("/";SUBSTITUE( ", "&STXT($A5;CHERCHE(ANNEE(AUJOURDHUI());$A5)+4;NBCAR($A5));",";"/";COLONNES($A:A)))+2)