Macro pour convertir

Version imprimable

14/06/2013, 10h27
Dubbleu

Macro pour convertir

Bonjour à tous,

je débute tout juste en VBA et je souhaiterais mettre en place une macros qui fasse de la conversion (dans le cadre d'un projet)

J'ai une colonne comportant les données qui sont sous la forme suivante
1500 DY
20 MO
2 YR
3000 FH
300 FC
(avec dy=day mo=month, yr=year, fh=flight hour et fc=flight cycle)
j'aimerais tout afficher dans une nouvelle colonne en DY (day)
avec des taux de convertion que je puisse adapter
(que je puisse fixer 1 DY = 4 FC par ex ou 1 MO= 30 DY)

Petit soucis dans certaines cases il y a plusieurs valeurs
"560 FC
90 DY" par exemple. dans ce cas je voudrais que les deux soient converties en DY et que la plus petite des deux soit reporté dans la nouvellle colonne...

J'ai commencé par me dire que je pouvais calculer toute les case a la main mais avec 1750 Lignes....

Un grand merci d'avance à toute personne qui pourrait me sauver ! n'hésiter pas si vous voulez plus d'info

Bonsoir,

En insérant la fonction personnalisé générique suivante, tu pourras convertir en DY toutes ces valeurs.

<ALT> + <F11> pour afficher l'éditeur VBA
Menu Insertion -> Module
Colle la fonction suivante dans le module
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 ' Calcul la somme de nombres pondérés par une clé à partir d'une chaîne au format '<nombre> <clé> [<nombre> <clé> [<nombre> <clé> ...]] ' val : la chaîne de caractère à calculer ' keys : plage contenant les clés ' values : plage contenant la valeur de chaque clé Public Function SumProdWithKey(val As String, keys As Range, values As Range) As Double val = UCase(val) If keys.Count <> values.Count Then Call Err.Raise(9, "SumProdWithKey", "Les plages de clés/valeurs doivent avoir le même nombre de valeurs") End If Dim c As Range For Each c In keys val = Replace(val, UCase(c), "*" & _ Replace(values.Cells(c.Row - keys.Row + 1, c.Column - keys.Column + 1), ",", ".") _ & "+") Next c If Right(val, 1) = "+" Then val = Left(val, Len(val) - 1) SumProdWithKey = Evaluate("=" & val) End Function
Depuis Excel,
- tape dans une ligne ou colonne les sigles à décoder (YR, MO ... y compris le sigle de DY)
- dans la ligne ou colonne à côté des sigles tu rentre le poids de chaque sigle (1 pour DY, 30 pour MO ....)
- dans la ligne ou colonne où tu souhaite afficher le résultat converti du tape la formule
=SumProdWithKey(<la valeur à convertir>;<la plage de cellules contenant les sigles>;<la plage de cellules contenant les valeurs de chaque sigle>)

1 pièce(s) jointe(s)

Bonjour,

Je ne sais pas si j'ai bien tout compris mais voilà, ci-dessous, la fonction que j'ai pondu. Cette dernière totalise dans le type souhaité (année, mois, jours, heures de vol, ou cycle de vol). Par défaut le total est fait en jours (Optional TypeConv As String = "DY"). Il te faut adapter les valeurs des constantes de conversion dans la fonction. Pour utiliser cette dernière, tu mets le code dans un module standard et tu entre les formules dans la colonne Excel sous la forme :

Code:

1
2
 
=CONVERSION($A$7:$A$11;E6)

Où A7:A11 représente la plage de tes valeurs et E6 le type de conversion (DY, YR, MO, FH, FC)
Tu dis :

Citation:

Petit soucis dans certaines cases il y a plusieurs valeurs
"560 FC
90 DY" par exemple. dans ce cas je voudrais que les deux soient converties en DY et que la plus petite des deux soit reporté dans la nouvellle colonne...

Dans ma fonction, les valeurs ne doivent pas être séparées par un retour à la ligne mais par un espace, de cette façon "560 FC 90 DY" sinon, précise et il me faudra adapter le code :

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
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
 
Public Function CONVERSION(Plage As Range, _
                           Optional TypeConv As String = "DY") As Double
 
    Dim Tbl()
    Dim Cel As Range
    Dim NB As Integer
    Dim Valeur As String
    Dim I As Integer
    Dim Total As Double
 
    'adapter les constantes
    Const NBJourAnnee As Integer = 365
    Const NBJourMois As Integer = 30
    Const NBJourHeure As Integer = 24
    Const NBJourCycle As Integer = 4
 
    Application.Volatile
 
    For Each Cel In Plage
 
        'supprime les éventuels espaces parasites de début et de fin
        Valeur = Trim(Cel.Value)
 
        'compte le nombre de paires
        NB = UBound(Split(Valeur, " "))
 
        'si deux paires (au moins 3 espaces), les récupère l'une à la suite de l'autre
        'Attention, si il y a un retour à la ligne dans la cellule, pas géré ici !
        If NB > 1 Then
 
            I = I + 2
            ReDim Preserve Tbl(1 To 2, 1 To I)
 
            Tbl(1, I - 1) = Split(Valeur, " ")(0)
            Tbl(2, I - 1) = Split(Valeur, " ")(1)
            Tbl(1, I) = Split(Valeur, " ")(2)
            Tbl(2, I) = Split(Valeur, " ")(3)
 
        'sinon, récupère la paire en cours
        Else
 
            I = I + 1
            ReDim Preserve Tbl(1 To 2, 1 To I)
 
            Tbl(1, I) = Split(Valeur, " ")(0)
            Tbl(2, I) = Split(Valeur, " ")(1)
 
        End If
 
    Next Cel
 
    'boucle sur le tableau pour totaliser en jours
    'avec conversion explicite en type double
    For I = 1 To UBound(Tbl, 2)
 
        Select Case UCase(Tbl(2, I))
 
            Case "YR"
 
                Total = Total + CDbl(Tbl(1, I)) * NBJourAnnee
 
            Case "MO"
 
                Total = Total + CDbl(Tbl(1, I)) * NBJourMois
 
            Case "DY"
 
                Total = Total + CDbl(Tbl(1, I))
 
            Case "FH"
 
                Total = Total + CDbl(Tbl(1, I)) / NBJourHeure
 
            Case "FC"
 
                Total = Total + CDbl(Tbl(1, I)) / NBJourCycle
 
        End Select
 
    Next I
 
    'effectue la conversion dans le type voulu et retourne le résultat
    Select Case TypeConv
 
        Case "YR"
 
            CONVERSION = Total / NBJourAnnee
 
        Case "MO"
 
            CONVERSION = Total / NBJourMois
 
        Case "DY"
 
            CONVERSION = Total
 
        Case "FH"
 
            CONVERSION = Total * NBJourHeure
 
        Case "FC"
 
            CONVERSION = Total * NBJourCycle
 
    End Select
 
End Function

Je te poste le classeur pour plus de facilité.

Hervé.

17/06/2013, 10h35
Dubbleu

Un dernier petit soucis

Bonjour à tous les deux !

Avant tout un énooooooooooooooorme merci (et encore c'est assez peu compte tenu du sauvetage)
J'ai réussi avec vos réponse à avoir un résultat plutot pas mal

et je m'adresse un peu plus particulièrement à toi Hervé,
dans mes cases EXCEL il y a un retour à la ligne :( et je ne peux pas modifier

il a même certaines case ou (avec un retour à la ligne toujours) il y a NOTE (en gros si on note un défaut avant les délai prévu) mais je ne veux surtout pas prendre en compte ce texte mais du coup ca m'affiche un petit #VALEUR!

"36000 FC
12 YR
NOTE"

Encore un grand merci

Bonjour,

Pour corriger la présence de retour à la ligne et de "NOTE" dans une cellule, tu peux utiliser la fonction Replace(valeur,<chaîne à remplacer>,<chaîne de remplacement>).

Les fonctions ci-dessous :
- ConversionEnDy(<valeur>) appelée depuis les formules Excel fait cette mise à jour, (les poids de clé sont dans la formule)
- TotalConversionEnDy(<Plage>) appelée depuis les formules Excel fait la somme d'une plage au format indiqué.

A+

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
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
Option Explicit
 
Type ClePoidStruct
    key As String
    Poid As Double
End Type
 
Public Function TotalConversionEnDy(vals As Range) As Double
 
    Application.Volatile 'nécessaire seulement si les paramètres passé à cette fonction sont eux même des résultats de fonctions
 
    Dim ClePoid(0 To 4) As ClePoidStruct
    Dim i As Integer
    i = -1
 
    i = i + 1: ClePoid(i).key = "DY":    ClePoid(i).Poid = 1
    i = i + 1: ClePoid(i).key = "MO":    ClePoid(i).Poid = 30
    i = i + 1: ClePoid(i).key = "YR":    ClePoid(i).Poid = 365
    i = i + 1: ClePoid(i).key = "FH":    ClePoid(i).Poid = 1 / 24
    i = i + 1: ClePoid(i).key = "FC":    ClePoid(i).Poid = 1 / 4
 
    Dim cell As Range
 
    TotalConversionEnDy = 0
    For Each cell In vals
        TotalConversionEnDy = TotalConversionEnDy + _
                         SommePondereAvecCle(Replace(Replace(UCase(cell), "NOTE", ""), vbLf, " "), _
                                             ClePoid)
    Next cell
 
End Function
 
Public Function ConversionEnDy(val As String) As Double
 
    Application.Volatile 'nécessaire seulement si les paramètres passé à cette fonction sont eux même des résultats de fonctions
 
    Dim ClePoid(0 To 4) As ClePoidStruct
    Dim i As Integer
    i = -1
 
    i = i + 1: ClePoid(i).key = "DY":    ClePoid(i).Poid = 1
    i = i + 1: ClePoid(i).key = "MO":    ClePoid(i).Poid = 30
    i = i + 1: ClePoid(i).key = "YR":    ClePoid(i).Poid = 365
    i = i + 1: ClePoid(i).key = "FH":    ClePoid(i).Poid = 1 / 24
    i = i + 1: ClePoid(i).key = "FC":    ClePoid(i).Poid = 1 / 4
 
    val = Replace(Replace(UCase(val), "NOTE", ""), vbLf, " ")
    ConversionEnDy = SommePondereAvecCle(val, ClePoid)
End Function
 
 
 
' Calcul la somme de nombres pondérés par une clé à partir d'une chaîne au format
'<nombre> <clé> [<nombre> <clé> [<nombre> <clé> ...]]
' val : la chaîne de caractère à calculer
' ClePoid : un tableau de valeur content les clé et poid correspondant
Private Function SommePondereAvecCle(val As String, ByRef ClePoid() As ClePoidStruct) As Double
    Dim i As Integer
    For i = 0 To UBound(ClePoid)
        val = Replace(val, UCase(ClePoid(i).key), "*" & _
                Replace(UCase(ClePoid(i).Poid), ",", ".") _
                    & "+")
    Next i
 
    If Right(val, 1) = "+" Then val = Left(val, Len(val) - 1)
    SommePondereAvecCle = Evaluate("=" & val)
End Function

Bonjour,

Avec la prise en compte de retour à la ligne et du mot NOTE :

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
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
 
Public Function CONVERSION(Plage As Range, _
                           Optional TypeConv As String = "DY") As Double
 
    Dim Tbl()
    Dim Cel As Range
    Dim NB As Integer
    Dim Valeur As String
    Dim I As Integer
    Dim Total As Double
 
    'adapter les constantes
    Const NBJourAnnee As Integer = 365
    Const NBJourMois As Integer = 30
    Const NBJourHeure As Integer = 24
    Const NBJourCycle As Integer = 4
 
    Application.Volatile
 
    For Each Cel In Plage
 
        'remplace le retour à la ligne par un espace
        Valeur = Replace(Cel.Value, Chr(10), " ")
 
        'supprime la note
        Valeur = Replace(Valeur, "NOTE", "")
 
        'supprime les éventuels espaces parasites de début et de fin
        Valeur = Trim(Valeur)
 
        'compte le nombre de paires
        NB = UBound(Split(Valeur, " "))
 
 
        'si deux paires (au moins 3 espaces), les récupère l'une à la suite de l'autre
        If NB > 1 Then
 
            I = I + 2
            ReDim Preserve Tbl(1 To 2, 1 To I)
 
            Tbl(1, I - 1) = Split(Valeur, " ")(0)
            Tbl(2, I - 1) = Split(Valeur, " ")(1)
            Tbl(1, I) = Split(Valeur, " ")(2)
            Tbl(2, I) = Split(Valeur, " ")(3)
 
        'sinon, récupère la paire en cours
        Else
 
            I = I + 1
            ReDim Preserve Tbl(1 To 2, 1 To I)
 
            Tbl(1, I) = Split(Valeur, " ")(0)
            Tbl(2, I) = Split(Valeur, " ")(1)
 
        End If
 
    Next Cel
 
    'boucle sur le tableau pour totaliser en jours
    'avec conversion explicite en type double
    For I = 1 To UBound(Tbl, 2)
 
        Select Case UCase(Tbl(2, I))
 
            Case "YR"
 
                Total = Total + CDbl(Tbl(1, I)) * NBJourAnnee
 
            Case "MO"
 
                Total = Total + CDbl(Tbl(1, I)) * NBJourMois
 
            Case "DY"
 
                Total = Total + CDbl(Tbl(1, I))
 
            Case "FH"
 
                Total = Total + CDbl(Tbl(1, I)) / NBJourHeure
 
            Case "FC"
 
                Total = Total + CDbl(Tbl(1, I)) / NBJourCycle
 
        End Select
 
    Next I
 
    'effectue la conversion dans le type voulu et retourne le résultat
    Select Case TypeConv
 
        Case "YR"
 
            CONVERSION = Total / NBJourAnnee
 
        Case "MO"
 
            CONVERSION = Total / NBJourMois
 
        Case "DY"
 
            CONVERSION = Total
 
        Case "FH"
 
            CONVERSION = Total * NBJourHeure
 
        Case "FC"
 
            CONVERSION = Total * NBJourCycle
 
    End Select
 
End Function

Hervé.

18/06/2013, 10h49
Dubbleu

Merci !

Un très grand merci pour votre précieuse aide ! tout marche parfaitement.