date

J

jbat

Guest
bonjour à tous,

j'ai un problème que je vais résumer ainsi:

j'ai un chiffre qui peut être sous la forme 201.77.112.417 donc string ou sous la forme 201177112417 donc nombre.

avec ce chiffre je peux retrouver une date de naissance en effet, le 77 correspond à l'année de naissance et le 112 c'est le mois suivit du jour de naissance.

je suis en train de faire une fonction qui me sort cette date de naissance mais j'ai quelques petits soucis quant à concatener le tout sous forme de date jj.mm.aaaa.
voilà donc si queqlu'un a une astuce...
merci et bon week-end à tous
 
J

Jean-Marie

Guest
Re...

Voici une solution en Vba en Sub pas en Function, pour changer le contenu de la cellule A2 et mettre le résultat en B2

Public Sub Elvete()
Dim vAnnee As Integer
Dim vMois As Byte
Dim vJour As Integer
Dim vVar As Variant
Dim ValCode As String

ValCode = Range("A2")
vVar = Evaluate("=Substitute(" & Chr(34) & ValCode & Chr(34) & "," & """.""" & ","""")")
vAnnee = Val(Mid(vVar, 4, 2))
vJour = Val(Mid(vVar, 6, 3))

vJour = vJour - (Int(vJour / 500) * 400)

Range("A1") = vVar

Select Case vJour
Case Is < 132
'janvier
vMois = 1
vJour = vJour - 100
Case Is < 163
'février
vMois = 2
vJour = vJour - 131
Case Is < 201
'mars
vMois = 3
vJour = vJour - 162
Case Is < 232
'avril`
vMois = 4
vJour = vJour - 200
Case Is < 263
'mai
vMois = 5
vJour = vJour - 231
Case Is < 301
'juin
vMois = 6
vJour = vJour - 262
Case Is < 332
'juillet
vMois = 7
vJour = vJour - 300
Case Is < 363
'août
vMois = 8
vJour = vJour - 331
Case Is < 401
'septembre
vMois = 9
vJour = vJour - 362
Case Is < 432
'octobre
vMois = 10
vJour = vJour - 400
Case Is < 463
'novembre
vMois = 11
vJour = vJour - 431
Case Is < 500
'décembre
vMois = 12
vJour = vJour - 462
End Select

Range("B2") = DateSerial(vAnnee, vMois, vJour)
End Sub
 
J

jbat

Guest
merci Jean-Marie...
comment marche un sub ?
je commence seulement maintenant le VBA et ne connait que les fonction, je l'utilise au début de ma programmation de ma fonction ? et si le num. n'est pas dans la cas a1 ?
 
J

Jean-Marie

Guest
Re...

Voici un nouveau code,

1) depuis ta feuille fait Alt F11, pour rentrer dans l'éditeur VBA
2) dans la fenêtre projet, sélectionne le nom de ton fichier
3) Clique sur le menu Insertion/module
4) dans la nouvelle fenêtre, colle le code ci-dessous

Public Sub Helvete()
Dim vAnnee As Integer
Dim vMois As Byte
Dim vJour As Integer
Dim vVar As Variant
Dim ValCode As Range

For Each ValCode In Selection
vVar = Evaluate("=Substitute(" & Chr(34) & ValCode & Chr(34) & "," & """.""" & ","""")")
vAnnee = Val(Mid(vVar, 4, 2))
vJour = Val(Mid(vVar, 6, 3))

vJour = vJour - (Int(vJour / 500) * 400)

Range("A1") = vVar

Select Case vJour
Case Is < 132
'janvier
vMois = 1
vJour = vJour - 100
Case Is < 163
'février
vMois = 2
vJour = vJour - 131
Case Is < 201
'mars
vMois = 3
vJour = vJour - 162
Case Is < 232
'avril`
vMois = 4
vJour = vJour - 200
Case Is < 263
'mai
vMois = 5
vJour = vJour - 231
Case Is < 301
'juin
vMois = 6
vJour = vJour - 262
Case Is < 332
'juillet
vMois = 7
vJour = vJour - 300
Case Is < 363
'août
vMois = 8
vJour = vJour - 331
Case Is < 401
'septembre
vMois = 9
vJour = vJour - 362
Case Is < 432
'octobre
vMois = 10
vJour = vJour - 400
Case Is < 463
'novembre
vMois = 11
vJour = vJour - 431
Case Is < 500
'décembre
vMois = 12
vJour = vJour - 462
End Select

ValCode.Offset(0, 1) = DateSerial(vAnnee, vMois, vJour)
Next
End Sub

Dans la ligne ValCode.offset(0,1) change la valeur de décalage du nombre de cellules. Valeur en A2 -> date en B2, pour Valeur en A2 -> date en D2, mettre (0,3)

5) Reviens dans ta feuille calcul, et créer un nouveau bouton pour le lancement de la macro, et affecte lui la macro Elvete

6) Sélectionne la plage des cellules contenant le code SécuSuisse, et appuie sur la macro.

@+Jean-Marie
 
J

Jean-Marie

Guest
Re...

1) clique sur le menu Outils personnalisés

Tu as deux possibilités, soit tu coches la barre d'outils formulaire, où la barre contrôle. vailde

2)dans la barre d'outils, que tu as choisie, clique sur le bouton, puis dans ta feuille de calcul, clique une fois et déplace-toi tout en maintenant le bouton enfoncé.

Voilà tu viens de créer un bouton.

3) Pour affecter une macro, clique sur le nouveau bouton, avec le bouton droit de la souris puis clique sur "affecter une macro ...", dans la boîte de dialogue qui s'affiche, sélectionne le nom de la macro Helvete, valide. À partir de ce moment, le bouton est activé.

@+Jean-Marie
 
J

jp

Guest
Re à vous tous,

Salut à Luc en particulier.....

je n'ai pas de réponse pour le moment à notre ami Suisse, mais Jean-Marie l'a pris en main... donc pas de problème...

En ce qui te concerne, fait un tour dans ta BAL, et sorry.......

Bonne soiré"e à tous.......

jp
 
J

Jean-Marie

Guest
Bonjour Jbat

La formule à mettre dans la cellule =Helvete(A1)

et le nouveau code de la function :

Public Function Helvete(vVar As Variant) As Date
Dim vAnnee As Integer
Dim vMois As Byte
Dim vJour As Integer
Dim ValCode As Range

If Mid(vVar, 4, 1) = "." Then
vVar = Mid(vVar, 1, 3) & Mid(vVar, 5, 2) & Mid(vVar, 8, 3) & Mid(vVar, 11, 3)
End If

vAnnee = Val(Mid(vVar, 4, 2))
vJour = Val(Mid(vVar, 6, 3))

vJour = vJour - (Int(vJour / 500) * 400)

Select Case vJour
Case Is < 132
'janvier
vMois = 1
vJour = vJour - 100

Case Is < 163
'février
vMois = 2
vJour = vJour - 131
Case Is < 201
'mars
vMois = 3
vJour = vJour - 162
Case Is < 232
'avril`
vMois = 4
vJour = vJour - 200
Case Is < 263
'mai
vMois = 5
vJour = vJour - 231
Case Is < 301
'juin
vMois = 6
vJour = vJour - 262
Case Is < 332
'juillet
vMois = 7
vJour = vJour - 300
Case Is < 363
'août
vMois = 8
vJour = vJour - 331
Case Is < 401
'septembre
vMois = 9
vJour = vJour - 362
Case Is < 432
'octobre
vMois = 10
vJour = vJour - 400
Case Is < 463
'novembre
vMois = 11
vJour = vJour - 431
Case Is < 500
'décembre
vMois = 12
vJour = vJour - 462
End Select

Helvete = DateSerial(vAnnee, vMois, vJour)
End Function

@+Jean-Marie
 
J

jbat

Guest
voici ma solution mais elle est encore à améliorer...
salutations à tous!

Function avs_nais(no_avs As Variant) As Date
Dim vAnnee As Integer
Dim vMois As Byte
Dim vJour As Integer
Dim avs3 As Integer
Dim avs2, avs1 As Boolean

'test le format'
If isnumberr(no_avs) = False Then
'format chaîne de caractere'
avs1 = False
ElseIf no_avs - Int(no_avs) = 0 Then
avs1 = True
'format numeric'
Else: avs1 = False
End If
'test sur les points'
If isnumberr(no_avs) = False And isnumberr(mid(no_avs, 4, 1)) = False And isnumberr(mid(no_avs, 7, 1)) = False Then
avs2 = True
'avs2 est un caractère'
Else: avs2 = False
'avs2 est un numéric'
End If

If avs1 = True And avs2 = True Then
avs_nais = "#Error in No_AVS format!"
ElseIf isnumberr(mid(no_avs, 4, 1)) = True Then
avs3 = 1
Else: avs3 = 2
End If

If isnumberr(mid(no_avs, (4 + 2 * avs3), 1)) = 0 Or isnumberr(mid(no_avs, (4 + 2 * avs3), 1)) = 9 Then
avs_naiss = "#Error in No_AVS format!"
End If


vAnnee = mid(no_avs, avs3 + 3, 2)

If mid(no_avs, (4 + 2 * avs3), 1) < 5 Then
vMois = (mid(no_avs, 4 + 2 * avs3, 1) - 1) * 3 + 1 + Int(mid(no_avs, 5 + 2 * avs3, 2) / 31.5)
Else: vMois = (mid(no_avs, 4 + 2 * avs3, 1) - 5) * 3 + 1 + Int(mid(no_avs, 5 + 2 * avs3, 2) / 31.5)
End If

If Modulo(mid(no_avs, 5 + 2 * avs3, 2), 31) = 0 Then
vJour = 31
Else: vJour = Modulo(mid(no_avs, 5 + 2 * avs3, 2), 31)
End If




If avs_nais >= Date Then
avs_nais = 1
Else: avs_nais = DateSerial(vAnnee, vMois, vJour)
End If


End Function
 

Discussions similaires