Automatisation d'une fonction

Version imprimable

Bonjour,

Étant débutant en VBA, je me permets de venir vers vous au sujet d'un problème que je rencontre.

J'extrait chaque jours différentes lignes qui ressemblent à cela, ces lignes sont différentes chaque jours :

Citation:

0.18M of {KFW 2.625 16/08/2019 Corp allq <go>} / -0.56 YtM
0.345M of {KFW 0.875 18/03/2019 Corp allq <go>} / -0.643 YtM
0.21M of {KFW 1.125 15/01/2020 Corp allq <go>} / -0.531 YtM

Mon problème est le suivant, je souhaiterais créer une macro me permettant de conserver ces lignes mais modifier le format de la date en anglais.

Que je puisse, à l'aide d'un bouton click, obtenir ceci :

Citation:

0.18M of {KFW 2.625 08/16/2019 Corp allq <go>} / -0.56 YtM
0.345M of {KFW 0.875 03/18/2019 Corp allq <go>} / -0.643 YtM
0.21M of {KFW 1.125 01/15/2020 Corp allq <go>} / -0.531 YtM

Un ami m'a donc donné ce code mais je n'arrive pas à l'automatiser :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 Function ModifChaineDate_ENFormat(strToModif As String, strRepere As String, dteLen As Integer, dteFormat As String) As String '' ' ' 'Modifie la date dans la chaine de caractère et retourner la chaine Dim OldCh As String, NewCh As String Dim startD, endD, lenCh, dte OldCh = strToModif lenCh = Len(strToModif) startD = InStr(1, OldCh, strRepere, vbTextCompare) - dteLen - 1 'Moins 1 pour l'espace endD = InStr(1, OldCh, strRepere, vbTextCompare) - 2 dte = Mid(OldCh, startD, dteLen) dte = VBA.Format(dte, dteFormat) NewCh = Left(OldCh, startD - 1) & dte & Right(OldCh, lenCh - endD) ModifChaineDate_ENFormat = NewCh End Function
Cependant, je n'arrive pas à automatiser cette macro.
Il faudrait que les données que j'extrait en colonne W apparaissent automatiquement en colonne X avec le bon format de date ?
J'ai de multiple ligne, l'idéal serait que la macro tourne jusqu'à que la prochaine ligne soit vide.

J'espère que quelqu'un pourra m'aider...

Je vous remercie, à bientôt

Bonjour,

Une piste, exécuter la Sub "Test" :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
 
Sub Test()
 
    Dim Tbl(1 To 3) As String
    Dim i As Integer
 
    Tbl(1) = "0.18M of {KFW 2.625 16/08/2019 Corp allq <go>} / -0.56 YtM"
    Tbl(2) = "0.345M of {KFW 0.875 18/03/2019 Corp allq <go>} / -0.643 YtM"
    Tbl(3) = "0.21M of {KFW 1.125 15/01/2020 Corp allq <go>} / -0.531 YtM"
 
    For i = 1 To 3: MsgBox Inverser(Tbl(i)): Next i
 
End Sub
 
Function Inverser(Chaine As String) As String
 
    Dim T
    Dim A As String
    Dim B As String
    Dim C As String
 
    T = Split(Chaine, "/")
    A = Format(Right(T(0), 2), "00")
    B = Format(T(1), "00")
    C = Left(T(2), 4)
 
    T = Split(Chaine, CDate(B & "/" & A & "/" & C))
 
    Inverser = T(0) & B & "/" & A & "/" & C & T(1)
 
End Function

16/01/2019, 11h50
MarcelG

Bonjour Snooz, Bonjour le Forum,

Salut THEZE, ravi de te retrouver. :P

Une piste plus "triviale"
Utiliser la méthode de chaîne de caractère

Code:

Instr

En fonction de la position trouvée du caractère délimiteur de date "/",
- calculer la date au bon format
- reconstituer la chaîne de caractères.
17/01/2019, 12h23
Theze

Hello Marcel !

Heureux de te lire (mais je suis aussi tes différents messages d'intervention !)

Citation:

Une piste plus "triviale"
Utiliser la méthode de chaîne de caractère

effectivement avec Instr() et InstrRev() mais aussi avec bien d'autres façons de faire :D
17/01/2019, 16h07
MarcelG

Salut Theze,

J'attends un peu pour livrer le code. Le temps que notre ami Snooz se manifeste.
Mais rien de bien compliqué.

A plus Theze :ccool:

Bonjour,

Merci pour vos réponses et désolé pour le retard.. La grippe m'a eu

J'ai essayé avec cela :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Function ModifChaineDate_ENFormat(strToModif As String, strRepere As String, dteLen As Integer, dteFormat As String) As String
 
                                    ''
                                    '
                                    '
                                    '
                                    'Modifie la date dans la chaine de caractère et retourner la chaine
 
                                    Dim OldCh As String, NewCh As String
                                    Dim startD, endD, lenCh, dte
 
                                    OldCh = strToModif
                                    lenCh = Len(strToModif)
 
                                    startD = InStr(1, OldCh, strRepere, vbTextCompare) - dteLen - 1 'Moins 1 pour l'espace
                                    endD = InStr(1, OldCh, strRepere, vbTextCompare) - 2
                                    dte = Mid(OldCh, startD, dteLen)
                                    dte = VBA.Format(dte, dteFormat)
 
                                    NewCh = Left(OldCh, startD - 1) & dte & Right(OldCh, lenCh - endD)
 
 
                                    ModifChaineDate_ENFormat = NewCh
 
End Function

Qui semble fonctionner avec une procédure test, seulement je n'arrive pas à l'automatiser...

Je recupère les données dans la colonne W sous cette forme :

0.18M of {KFW 2.625 16/08/2019 Corp allq <go>} / -0.56 YtM

Et souhaiterais récupérer le résultat en colonne X.

21/01/2019, 10h19
MarcelG

Bonjour Snooz,

Tu peux utiliser la fonction que tu as créée
- soit par VBA
- soit directement dans la feuille de travail

Un tutoriel à consulter pour cela
Les fonctions personnelles

Bonjour,

Essaies :

Code:

1
2
3
4
5
6
7
8
Function ModifChaineDate_ENFormat(strToModif As String) As String
' Modifie la date dans la chaine de caractère et retourner la chaine
Dim T, D
  T = Split(strToModif, " ")
  D = Split(T(4), "/")
  T(4) = D(1) & "/" & D(0) & "/" & D(2)
  ModifChaineDate_ENFormat = Join(T, " ")
End Function

21/01/2019, 10h50
MarcelG

Bonjour Patrice,

Certes ton code est rigoureux. :ccool:
Au demeurant, les données à modifier comportant des espaces, il faut être sûr que le tableau Split soit bien alimenté.
Autrement dit, que le nombre d'espace (au moins jusqu'à la date) soit le même pour toutes les cellules.
Dans ce cas, la première occurrence à utiliser serait à une place ultérieure.
21/01/2019, 11h12
Patrice740

Bonjour Marcel,

Citation:

Envoyé par MarcelG

... Dans ce cas, la première occurrence ...

Effectivement, si l'exemple n'est pas bon, mais c'est aussi le cas avec Instr si l'élément cherché ...

1 pièce(s) jointe(s)

Bonjour
si le format des chaines est constants alors simplement un petit split, un replace

dans un module standard tu colle ceci:
Code:

1 2 3 4 5 6 7 8 9 Public Function dateInversee(ByVal cel As Range) Dim dat As String If InStr(cel.Value, " Corp ") > 0 Then dat = Right(Split(cel.Value, " Corp")(0), 10) dateInversee = Replace(cel.Value, dat, Format(dat, "mm/dd/yyyy")) Else dateInversee = "" End If End Function
et dans les cellules de destination tu met
cette simple formule
exemple en H1 pour modifier la cellule A1 tu met :

Citation:

=dateInversee(A1)

bien sur la fonction est utilisable par vba
Code:

1 2 3 Sub test() MsgBox dateInversee([A1]) End Sub
demo
Pièce jointe 443205
;)

1 pièce(s) jointe(s)

re
et si !!!! le format n'est pas constant alors on sort l'artillerie lourde

toujours pareil dans un module standard

Code:

1
2
3
4
5
6
7
8
Public Function dateInversee2(ByVal mavar As String)
    Dim matchs
    With CreateObject("VBScript.RegExp"):
        .Global = True: .IgnoreCase = True: .Pattern = "(\d+)\/(\d+)\/(\d+)"
        Set matchs = .Execute(mavar)
        If matchs.Count > 0 Then dateInversee2 = Replace(mavar, matchs(0), Format(matchs(0), "mm/dd/yyyy")) Else dateInversee2 = "Nofound Date!!"
    End With
End Function

la formule c'est la meme chose

Citation:

=dateInversee2(A1)

et toujours utilisable par VBA

Code:

1
2
3
Sub test()
    MsgBox dateInversee2([A1])
End Sub

DEMO
Pièce jointe 443213
;)

Bonjour à tous,

une proposition qui ne fonctionne que s'il n'y a pas de "/" avant la date, le tableau est utiliser à la recopie pour gagner du temps.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
Sub InverseDate()
 Dim T, i As Long, Deb As Byte, DateInvers As String
 With Worksheets("Feuil1")
 T = .Range("A1:A" & .Range("A" & Rows.Count).End(xlUp).Row) ' à adapter pour W
 For i = LBound(T) To UBound(T)
    Deb = InStr(T(i, 1), "/") - 2
    DateInvers = Format(Mid(T(i, 1), Deb, 10), "mm/dd/yyyy")
    Mid(T(i, 1), Deb, 10) = DateInvers
 Next
 .Range("F1").Resize(UBound(T)) = T  ' à adapter pour X
 End With
End Sub

bonne journée

1 pièce(s) jointe(s)

re
et !! au cas ou avec la version 2 il y aurait bien une chaine "xx/xx/xxxx" MAIS!! que ce ne soit pas une date valide !!!
on ajoute un avertisseur dans la chaine résultante car la date ne sera pas inversee je viens de tester ;)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
 
Public Function dateInversee2(ByVal mavar As String)
    Dim matchs
    With CreateObject("VBScript.RegExp"):
        .Global = True: .IgnoreCase = True: .Pattern = "(\d+)\/(\d+)\/(\d+)"
        Set matchs = .Execute(mavar)
        If matchs.Count > 0 Then
            dateInversee2 = Replace(mavar, matchs(0), Format(matchs(0), "mm/dd/yyyy") & IIf(Not IsDate(matchs(0)), "Invalid Date!!", ""))
        Else: dateInversee2 = "Nofound Date!!"
        End If
    End With
End Function

Pièce jointe 443220

24/01/2019, 10h53
Snooz4

Et bien c'est parfait !

Merci beaucoup pour votre aide, c'est super.

Bonne journée à vous tous.