Conversion d'un nombre en "packed number", et inversement

Soyez le premier à donner votre avis sur cette source.

Snippet vu 3 880 fois - Téléchargée 18 fois

Contenu du snippet

Fonction permettant de convertir un nombre (entier ou décimal, positif ou négatif) en nombre packé ("packed number" utilisé en DB2).
La fonction a 3 arguments :
- le nombre à traiter
- le nombre de positions de la partie entière du nombre après conversion
- le nombre de décimales du nombre après conversion.
Par exemple, la conversion du nombre -12345.67 en "packed number" avec 8 positions de l'entier et 2 positions pour la partie décimale donne donc l'appel à la fonction suivant :
pack_num(-12345.67,8,2)
et le résultat suivant :
000123456P

Fonction permettant de convertir un nombre packé ("packed number" utilisé en DB2) en nombre entier ou décimal, positif ou négatif (suivant le nombre packé).
La fonction a 1 seul argument :
- le nombre à traiter

Par exemple, la conversion du nombre packé 000123456P donne donc l'appel à la fonction suivant :
signed_num("000123456P")
et le résultat suivant :
-12345.67

Source / Exemple :


Function Pack_Num(NumberToConvert As Double, EntirePositionsCount As Integer, DecimalPositionsCount As Integer) As String
   
    '** Code from WebSeb's Code Snippets
    '** http://www.google.fr/notebook/public/04546795133968900189/BDRsRSwoQ27D2_9Mh
    '** Version 01 - 2010-02-24
    '** Explanation : allows a number to be packed for mainframe databases
    '** See Also : Function Signed_Num allowing a number to be unpacked
       
    'sample :
    ' -123.45 = 000001234N if the amt = -123.45, EntirePositionsCount = 8 and DecimalPositionsCount = 2
    '
    'A "packed" number replaces the last (right-most) digit with a letter to indicate both value and sign:
    '{=0    }=-0
    'A=1    J=-1
    'B=2    K=-2
    'C=3    L=-3
    'D=4    M=-4
    'E=5    N=-5
    'F=6    O=-6
    'G=7    P=-7
    'H=8    Q=-8
    'I=9    R=-9
       
    Dim TmpVal As String
       
    TmpVal = String(EntirePositionsCount + DecimalPositionsCount, "0")
    TmpVal = TmpVal & Abs(Fix(NumberToConvert))
    TmpVal = TmpVal & Right(Round(Abs(NumberToConvert) * Int("1" & String(DecimalPositionsCount, "0"))), DecimalPositionsCount)
    TmpVal = Right(TmpVal, EntirePositionsCount + DecimalPositionsCount)
   
    'Debug.Print TmpVal
   
    Select Case NumberToConvert < 0
        Case True
            Select Case Right(TmpVal, 1)
                Case 0
                    last = "}"
                Case 1
                    last = "J"
                Case 2
                    last = "K"
                Case 3
                    last = "L"
                Case 4
                    last = "M"
                Case 5
                    last = "N"
                Case 6
                    last = "O"
                Case 7
                    last = "P"
                Case 8
                    last = "Q"
                Case 9
                    last = "R"
            End Select
        Case Else
            Select Case Right(TmpVal, 1)
                Case 0
                    last = "{"
                Case 1
                    last = "A"
                Case 2
                    last = "B"
                Case 3
                    last = "C"
                Case 4
                    last = "D"
                Case 5
                    last = "E"
                Case 6
                    last = "F"
                Case 7
                    last = "G"
                Case 8
                    last = "H"
                Case 9
                    last = "I"
            End Select
    End Select
   
    TmpVal = Mid(TmpVal, 1, EntirePositionsCount + DecimalPositionsCount - 1) & last
   
    Pack_Num = TmpVal
   
End Function

Function Signed_Num(theAmt As Variant) As Double

    '** Code from WebSeb's Code Snippets
    '** http://www.google.fr/notebook/public/04546795133968900189/BDRsRSwoQ27D2_9Mh
    '** Version 01 - 2009-05-20
    '** Explanation : allows a packed number to be converted to human readable format
    '** See Also : Function Pack_Num allowing a number to be packed
   
    Dim thelast As String
    Dim theFrnt As String
   
    thelast = Right(RTrim(LTrim(theAmt)), 1)
    theFrnt = Mid$(theAmt, 1, Len(theAmt) - 1)
   
    If thelast = "{" Or thelast = "0" Then
        thelast = "0"
        Signed_Num = Val(theFrnt & thelast) / 100
    ElseIf thelast = "A" Or thelast = "1" Then
        thelast = "1"
        Signed_Num = Val(theFrnt & thelast) / 100
    ElseIf thelast = "B" Or thelast = "2" Then
        thelast = "2"
        Signed_Num = Val(theFrnt & thelast) / 100
    ElseIf thelast = "C" Or thelast = "3" Then
        thelast = "3"
        Signed_Num = Val(theFrnt & thelast) / 100
    ElseIf thelast = "D" Or thelast = "4" Then
        thelast = "4"
        Signed_Num = Val(theFrnt & thelast) / 100
    ElseIf thelast = "E" Or thelast = "5" Then
        thelast = "5"
        Signed_Num = Val(theFrnt & thelast) / 100
    ElseIf thelast = "F" Or thelast = "6" Then
        thelast = "6"
        Signed_Num = Val(theFrnt & thelast) / 100
    ElseIf thelast = "G" Or thelast = "7" Then
        thelast = "7"
        Signed_Num = Val(theFrnt & thelast) / 100
    ElseIf thelast = "H" Or thelast = "8" Then
        thelast = "8"
        Signed_Num = Val(theFrnt & thelast) / 100
    ElseIf thelast = "I" Or thelast = "9" Then
        thelast = "9"
        Signed_Num = Val(theFrnt & thelast) / 100
    '==========================================================
    ElseIf thelast = "}" Then
        thelast = "0"
        Signed_Num = Val(theFrnt & thelast) / -100
    ElseIf thelast = "J" Or thelast = "1" Then
        thelast = "1"
        Signed_Num = Val(theFrnt & thelast) / -100
    ElseIf thelast = "K" Or thelast = "2" Then
        thelast = "2"
        Signed_Num = Val(theFrnt & thelast) / -100
    ElseIf thelast = "L" Or thelast = "3" Then
        thelast = "3"
        Signed_Num = Val(theFrnt & thelast) / -100
    ElseIf thelast = "M" Or thelast = "4" Then
        thelast = "4"
        Signed_Num = Val(theFrnt & thelast) / -100
    ElseIf thelast = "N" Or thelast = "5" Then
        thelast = "5"
        Signed_Num = Val(theFrnt & thelast) / -100
    ElseIf thelast = "O" Or thelast = "6" Then
        thelast = "6"
        Signed_Num = Val(theFrnt & thelast) / -100
    ElseIf thelast = "P" Or thelast = "7" Then
        thelast = "7"
        Signed_Num = Val(theFrnt & thelast) / -100
    ElseIf thelast = "Q" Or thelast = "8" Then
        thelast = "8"
        Signed_Num = Val(theFrnt & thelast) / -100
    ElseIf thelast = "R" Or thelast = "9" Then
        thelast = "9"
        Signed_Num = Val(theFrnt & thelast) / -100
    End If

End Function

Conclusion :


Le code a été développé en VBA afin d'utiliser la fonction dans une Query.

A voir également

Ajouter un commentaire

Commentaires

Messages postés
3983
Date d'inscription
jeudi 14 juillet 2005
Statut
Membre
Dernière intervention
30 juin 2013
12
On passe de 56 lignes de code (pas de commentaires ni de passages à la ligne inutiles) à 10 lignes de code.
Y'a pas photo, ma solution est la plus courte (mais il vaudrait mieux vérifier si elle fonctionne complètement)
Messages postés
13280
Date d'inscription
lundi 13 décembre 2004
Statut
Modérateur
Dernière intervention
3 février 2018
35
j'ai parlé un peu vite oui, le code est à optimiser comme l'indique ghuysmans99. reste à voir la taille qu'il prendra alors

++
Messages postés
13280
Date d'inscription
lundi 13 décembre 2004
Statut
Modérateur
Dernière intervention
3 février 2018
35
salut,
"Code from WebSeb's Code Snippets"
en effet limite "snippet" = à poster sur codyx.org

j'ai mis à jour pour fusionner tes 2 sources, un peu plus conséquent, ainsi ce code peut rester ici ;)

bonne continuation
Messages postés
3983
Date d'inscription
jeudi 14 juillet 2005
Statut
Membre
Dernière intervention
30 juin 2013
12
Oops, le code que j'ai posté n'est pas bon.
Voilà la correction :

Public Function PackNum(NumberToConvert As Double, EntirePositionsCount As Integer, DecimalPositionsCount As Integer) As String
Dim TmpVal As String, Last As String * 1
Dim TranslationTable As String: TranslationTable = "{ABCDEFGHI}JKLMNOPQR"
TmpVal = String(EntirePositionsCount + DecimalPositionsCount, "0") & Abs(Fix(NumberToConvert))
TmpVal = TmpVal & Right(Round(Abs(NumberToConvert) * Int("1" & String(DecimalPositionsCount, "0"))), DecimalPositionsCount)
TmpVal = Right(TmpVal, EntirePositionsCount + DecimalPositionsCount) If NumberToConvert < 0 Then Last Mid(TranslationTable, 10 + CInt(Right(TmpVal, 1)), 1) Else Last Mid(TranslationTable, CInt(Right(TmpVal, 1)), 1)
TmpVal = Mid(TmpVal, 1, EntirePositionsCount + DecimalPositionsCount - 1) & Last
PackNum = TmpVal
End Function
Messages postés
3983
Date d'inscription
jeudi 14 juillet 2005
Statut
Membre
Dernière intervention
30 juin 2013
12
Y'a vraiment moyen de faire plus court :

Option Explicit
Dim TranslationTable(19) As String * 1

Public Sub InitTable()
Dim i As Integer TranslationTable(0) "{": TranslationTable(10) "}" For i 1 To 9: TranslationTable(i) Chr(i + 64): Next i For i 11 To 19: TranslationTable(i) Chr(i + 63): Next i
End Sub

Public Function PackNum(NumberToConvert As Double, EntirePositionsCount As Integer, DecimalPositionsCount As Integer) As String
Dim TmpVal As String, Last As String * 1
TmpVal = String(EntirePositionsCount + DecimalPositionsCount, "0") & Abs(Fix(NumberToConvert))
TmpVal = TmpVal & Right(Round(Abs(NumberToConvert) * Int("1" & String(DecimalPositionsCount, "0"))), DecimalPositionsCount)
TmpVal = Right(TmpVal, EntirePositionsCount + DecimalPositionsCount) If NumberToConvert < 0 Then Last TranslationTable(10 + CInt(Right(TmpVal, 1))) Else Last TranslationTable(CInt(Right(TmpVal, 1)))
TmpVal = Mid(TmpVal, 1, EntirePositionsCount + DecimalPositionsCount - 1) & Last
Pack_Num = TmpVal
End Function
Afficher les 7 commentaires

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.