Réduction du nombre de décimales dans une suite de nombres

Le 04/05/2022 à 08:27

Bonjour à tous,

Je voudrais savoir s'il est possible (en vba, car mes fichiers font parfois plusieurs centaines de lignes) de réduire à 3 décimales des coordonnées de polygones qui prennent trop de place et qui parfois dépassent les capacités d'une cellule ?

Éventuellement avec un arrondi -> pas obligatoire.

Ex de coordonnées :

POLYGON ((817526.767354497 6909552.24251502,817529.418729568 6909575.66203338,817544.281675545 6909592.87808133,817613.388505107 6909638.12995565,817630.998192184 6909649.17171856,817648.021112421 6909660.42405067,817678.512155941 6909692.981044,817699.103948374 6909732.56755855,817750.960404699 6909862.80706836,817861.199135696 6909847.37638323,817866.59077167 6909811.66007804,817841.081717663 6909774.08606497,817803.873962992 6909714.13087634,817792.850377336 6909658.82944482,817871.77943808 6909650.9906465,817981.888933425 6909603.07062727,817996.522918666 6909698.72397886,818024.40220223 6909769.72645188,818044.678452572 6909753.67595477,818020.099925939 6909720.45954826,818008.38011455 6909667.25736695,818013.490170397 6909538.96424047,817970.161635076 6909550.20223047,817901.748352316 6909591.85701588,817839.313731134 6909608.26715361,817766.130068492 6909627.01670832,817766.074321421 6909651.04846946,817765.8460297 6909669.29099878,817785.429598294 6909715.42170779,817801.791964262 6909737.56479944,817826.314853215 6909770.00026858,817863.266339309 6909810.4792466,817857.679238804 6909845.07890782,817837.426147497 6909831.64566008,817815.182773687 6909826.51645088,817780.848977514 6909818.13536074,817767.012905294 6909800.60589579,817724.401689355 6909684.57492936,817718.182562368 6909622.13998691,817670.0219107 6909595.67420793,817622.849743402 6909581.35678422,817596.436954765 6909573.58405234,817526.767354497 6909552.24251502))

Résultat souhaité :
POLYGON ((817526.767 6909552.243,817529.419 6909575.662,817544.282 6909592.878,817613.389 6909638.130,817630.998 6909649.171,...))

Merci d'avance pour votre aide.
Dan

Le 04/05/2022 à 08:43

Bonjour,

Si j'ai bien compris, chaque nombre à convertir n'est pas disposé dans une cellule distincte, mais les uns à la suite des autres dans une même cellule ?

Un essai avec une fonction VBA personnalisée :

Public Function ConvertCoordonnees(ByVal Txt_a_convertir As String) As String

Dim Res As String, Spl1() As String, Spl2() As String, i As Integer, j As Integer, DecSep As String

Res = Replace(Replace(Txt_a_convertir, "POLYGON ((", ""), "))", "")
Spl1 = Split(Res, ",")
Res = ""
For i = LBound(Spl1) To UBound(Spl1)
    Spl2 = Split(Spl1(i), " ")
    For j = LBound(Spl2) To UBound(Spl2)
        If Res = "" Then Res = "POLYGON (("
        Res = Res & Replace(Format(Replace(Spl2(j), ".", ",") * 1, "0.000"), ",", ".")
        If j = UBound(Spl2) Then
            If Not i = UBound(Spl1) Then Res = Res & "," Else Res = Res & "))"
        Else
            Res = Res & " "
        End If
    Next j
Next i
ConvertCoordonnees = Res

End Function

Une fois ajoutée à l'éditeur VBA, la fonction s'utilise comme une fonction Excel classique :

=ConvertCoordonnees(A1)
Le 04/05/2022 à 09:20

Bonjour,

C'est bien cela.

Le séparateur entre 2 nombres est bien l'espace.

Le séparateur entre 2 coordonnées est la virgule.

En limitant à 2 coordonnées : ça donnerait : POLYGON ((817526.767354497 6909552.24251502,817529.418729568 6909575.66203338))

Abs1 : 817526.767354497 - Ord1 : 6909552.24251502

Abs2 : 817529.418729568 - Ord2 : 6909575.66203338

Le 04/05/2022 à 09:47

Merci pour la fonction Pedro22,

J'obtiens la réponse suivante : #VALEUR!

La fonction ne va pas jusqu'au bout, mais s'arrête à cette ligne : Res = Res & Replace(Format(Replace(Spl2(j), ".", ",") * 1, "0.000"), ",", ".")

Bonne journée,

Dan

Le 04/05/2022 à 10:04

Peux tu fournir le fichier sur lequel tu l'as testé, avec quelques données ?

Le 04/05/2022 à 10:27

Voici un fichier avec juste la colonne de coordonnées.

Merci beaucoup pour ton aide,

Dan

7fichier-ex.xlsm (20.93 Ko)
Le 04/05/2022 à 10:31

Je n'ai aucun message d'erreur à l'ouverture de ton fichier, chez moi tout fonctionne. Quel est ton séparateur décimal par défaut dans Excel ?

Le 04/05/2022 à 11:00

le point

Le 04/05/2022 à 11:15

Un essai :

Public Function ConvertCoordonnees(ByVal Txt_a_convertir As String) As String

Dim Res As String, Spl1() As String, Spl2() As String, i As Integer, j As Integer, DecSep As String

Res = Replace(Replace(Txt_a_convertir, "POLYGON ((", ""), "))", "")
Spl1 = Split(Res, ",")
Res = ""
For i = LBound(Spl1) To UBound(Spl1)
    Spl2 = Split(Spl1(i), " ")
    For j = LBound(Spl2) To UBound(Spl2)
        If Res = "" Then Res = "POLYGON (("
        Res = Res & Replace(Format(Spl2(j) * 1, "0.000"), ",", ".")
        If j = UBound(Spl2) Then
            If Not i = UBound(Spl1) Then Res = Res & "," Else Res = Res & "))"
        Else
            Res = Res & " "
        End If
    Next j
Next i
ConvertCoordonnees = Res

End Function
Le 04/05/2022 à 12:01

Bravo Pedro !

Ça fonctionne.
Pas évident à comprendre pour moi, mais c'est super.

Merci beaucoup,

Dan

Le 04/05/2022 à 12:03
Dan67100 a écrit :

Pas évident à comprendre pour moi, mais c'est super.

Je peux toujours commenter le code, si tu veux !

Le 04/05/2022 à 12:06

Je suis preneur,

Merci

Le 04/05/2022 à 12:11
Public Function ConvertCoordonnees(ByVal Txt_a_convertir As String) As String

'Déclaration du type de donnée stockée dans les variables utilisées (String --> texte, Integer --> Nombre entier)
Dim Res As String, Spl1() As String, Spl2() As String, i As Integer, j As Integer, DecSep As String

'On supprime les extrémités du texte pour ne garder que les valeurs numériques
Res = Replace(Replace(Txt_a_convertir, "POLYGON ((", ""), "))", "")
'On découpe le texte selon les virgules
Spl1 = Split(Res, ",")
'Suppression du contenu de la variable Res (car je la réutilise plus loin)
Res = ""
'Boucle sur le éléments découpés (pour 10 éléments, i passera de 0 à 9 par palier de +1)
For i = LBound(Spl1) To UBound(Spl1)
    'On découpe à nouveau chaque morceau de texte selon les espaces
    Spl2 = Split(Spl1(i), " ") 
    'Boucle sur les éléments découpés (normalement 2 à chaque fois)
    For j = LBound(Spl2) To UBound(Spl2)
        'Au premier passage uniquement, on remet la première extrémité du texte
        If Res = "" Then Res = "POLYGON (("
        'On colle à la suite le nombre arrondi à 3 décimales (Replace = fonction Excel SUBSTITUE, Format = fonction Excel TEXTE)
        Res = Res & Replace(Format(Spl2(j) * 1, "0.000"), ",", ".")
        'On ajoute un séparateur (alternativement espace ou virgule) et pour le dernier élément on rajoute l'extrémité retiré au début (les parenthèses)
        If j = UBound(Spl2) Then
            If Not i = UBound(Spl1) Then Res = Res & "," Else Res = Res & "))"
        Else
            Res = Res & " "
        End If
    Next j
Next i
ConvertCoordonnees = Res 'Renvoie du résultat de la fonction

End Function

Pour les structures utilisées :

- If [condition(s)] Then [instruction(s)] Else [instruction(s)] --> Si...Alors...Sinon (sinon facultatif)

- For Variable = ValeurDébut To ValeurFin Step Palier --> Pour ... allant de ... à ... par palier de ... (palier facultatif, +1 par défaut)

Le 04/05/2022 à 12:21

Vraiment super sympa !

Merci encore,

Dan

Le 04/05/2022 à 14:49

Bonjour à tous,

J'arrive après la bataille, brillamment remportée Pedro22 () (Côtes-d'Armor ?) mais je propose tout de même cette approche Power Query (nativement intégré à votre version Excel) avec un arrondi :

4dan67100-pq-reduction-decimales-v0.xlsx (30.04 Ko)
Le 04/05/2022 à 16:04

Bonjour et merci pour cette proposition JFL.

Je n'ai malheureusement pas eu le temps de me pencher sur Power Query et je le regrette, mais je suis sûr que ça viendra.

J'ai jeté un œil rapidement et je vois l'erreur suivante :

Expression.Error : 5 arguments ont été passés à une fonction qui en attendait entre 2 et 4.
Détails :
Pattern=
Arguments=List

Bon am,

Dan

Le 04/05/2022 à 16:14

Bonjour de nouveau,

Je viens de tester ma proposition......avec succès !

Votre essai a été effectué sur mon fichier ?

Votre produit Excel est à jour ?
Le 04/05/2022 à 17:04

J'ai une version Excel 2016 (au travail) que je ne peux pas mettre à jour.

C'est peut-être le problème.

Je testerai ce soir sur la version 365 et vous tiendrez au courant.

Merci encore pour votre proposition,

Dan

Le 04/05/2022 à 22:29

Bonsoir JFL,

J'ai testé chez moi avec PQ et effectivement je n'ai plus de message d'erreur.

Il faudra toutefois que je me familiarise un peu avec PQ !

Merci encore,

Dan

Rechercher des sujets similaires à "reduction nombre decimales suite nombres"