Contrôle de longitude / latitude

**dede_bo** · 08/04/2021, 15h09

Bonjour à toute et tous

Je suis sur un problème qui devient mon clou de cercueil.
J'explique,

J'ai crée un template ou les utilisateurs doivent encoder des longitudes et latitudes.
La valeur que l'on trouve dans la cellule, peut être unique ou une plage de valeurs séparées par des ","
Les valeurs doivent avoir obligatoirement un minimum de 2 chiffres après le séparateur de décimal.

exemple:

Longitude	Latitude
-4.45	12.0345
12.00, 15.23	-3.02, 3.3456
137.00	56.01
-123.34	23.33, 24.02

Le but de mon travail est de contrôler que les valeurs encodées soient correctes.

Là où cela devient un véritable cauchemar, c'est que les utilisateurs viennent des 4 coins du monde ...

Certains ont le "." comme séparateur décimal et le "," comme séparateur de millier
et d'autres "," comme séparateur décimal et le "." comme séparateur de millier

Et je reçois des valeurs du style :

Longitude	Latitude
14,34,23,56	-2,23,34.34
134,34,145,45	-23,04, 12.08

L'enfer commence ...

Comment résoudre un tel problème?

Au départ, je ne sais pas si l'utilisateur encode 1 valeur ou une liste de valeurs
Ensuite, les virgules que je trouve .... Est-ce un séparateur de milliers ou de décimal ?
Même question pour le point ...

Que dois-je contrôler?

a) Le contenu de la cellule ne peut contenir que des nombres entre 0 & 9. Et également le "." et la ","
b) le nombre doit avoir au minimum 2 chiffres après le caractère de séparation des décimale
c) la longitude : une valeur comprise entre -180.00 et 180.00
d) la latitude : une valeur comprise entre -90.00 et 90.00

La situation actuelle:

Vu que les utilisateurs peuvent encoder une liste dans une cellule, le type de la cellule n'est pas numérique mais du texte.
La taille du fichier est énorme. Un fichier avec 65000 lignes est très courant.
D'où l'utilisation du VBA pour le contrôle

Afin de me faciliter la vie, j'ai crée une fonction qui contrôle les deux (longitude / latitude)
Il suffit de passer les bonnes valeurs à la fonction

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
 
Function CheckLocation(location As String, Optional ByVal fg_direction As Boolean = True) As String
 
    ' La fonction contrôle si la valeur "location" suit les règles pour la longitude ou la latitude
    ' the flag "fg_direction" contrôle la longitude (false) ou la latitude (true - default)
    '
    ' Si le contrôle ne détecte aucune erreur, la fonction retourne "" autrement elle retourne la raison de l'erreur
    ' -----------------------------------------------------------------------------------------------------------------------
 
    Dim result As String
    Dim location1 As String, location2 As String, tmplocation As String, txte As String
    Dim resultStr As String, strPattern As String, tmp As String
    Dim part As String, config As String
    Dim p As Integer, p1 As Integer, x1 As Integer, x2 As Integer
    Dim ct As Integer, multi As Integer
    Dim lgt As Variant
    Dim fg_check As Boolean
    Dim occurence
    Dim configPC As String, separator As String, decimalChr As String
    Dim regEx As New RegExp
    Dim chkRules As Boolean
 
    If Len(location) = 0 Then
        result = "No values"
    Else
        chkRules = CheckLocationRules(location)
        If Not chkRules Then
            result = " The value: '" & location & "' don't follow the business rules"
        Else
 
            ' Contrôle si des autres caractères sont présent dans la chaine
 
            strPattern = "[a-zA-Z]"
 
            With regEx
                .Global = True
                .MultiLine = True
                .IgnoreCase = False
                .Pattern = strPattern
            End With
 
            If regEx.test(location) Then
                result = " The value '" & location & "' can't contains any characters"
            Else
                occurence = Split(location, ",")
                configPC = Application.DecimalSeparator
 
 
                If configPC = "," Then
                    config = ","
                Else
                    config = "."
                End If
 
                resultStr = location
                tmp = ""
 
                If InStr(1, location, ",") = 0 Then
                    ' Cas d'une seule valeur
 
                    tmplocation = resultStr
                    fg_check = False
                    GoSub checkRules
                    tmp = tmplocation
                Else
                    ' Cas de plusieurs valeurs
 
                    Do While resultStr Like "*,*"  'boucle tant que texte contient une virgule
 
                        x1 = InStr(resultStr, config)       ' x1 est l'index de placement de la virgule -1 pour le chiffre
                        ct = 1
                        Do
                            x2 = InStr(x1 + ct, resultStr, ",")  ' x2 est l'index de séparation des valeurs
                            ct = ct + 1
                        Loop Until x2 >= 5 Or ct > 5
 
                        If x2 = 0 Then
                            x2 = InStrRev(resultStr, ",", x1 - 1)
                        End If
 
                        If x2 = 0 Then
                            txte = resultStr
                        Else
                            txte = Trim(Left(resultStr, x2 - 1))
                        End If
 
                        part = " frst nbr: "
                        tmplocation = txte
                        fg_check = False
                        GoSub checkRules
                        resultStr = Trim(Mid(resultStr, x2 + 1))
                        tmp = tmplocation
 
 
 
                        If x2 - 1 > 0 Then
                            txte = resultStr             ' on enleve ce que l'on a visté dans la chaine de base
                        Else
                            txte = ""
                        End If
                        resultStr = ""
                    Loop
                End If
 
                If txte <> "" Then
                    part = " sec nbr: "
                    fg_check = False
                    tmplocation = txte
                    GoSub checkRules
                    tmp = tmp & "," & tmplocation
                End If
 
                If tmp <> "" Then
                    location = tmp
                End If
 
                If result <> "" Then
                    CheckLocation = Mid(result, 1, Len(result) - 1)
                Else
                    CheckLocation = result
                End If
            End If
        End If
    End If
    CheckLocation = result
 
    Exit Function
 
checkRules:
    p = InStr(1, tmplocation, ".")
    Select Case p
        Case Is > 0
            multi = (Len(tmplocation) - p)
        Case 0
            p1 = InStr(1, tmplocation, ",")
            Select Case p1
                Case Is > 0
                    multi = (Len(tmplocation) - p1)
                Case 0
                    multi = 0
            End Select
    End Select
 
    lgt = CDec(tmplocation)              ' C'est sur cette instruction que cela explose pour certain pays (Type mistmach)
    decimalChr = String(2, "0")
 
    If multi <> 0 Then
        'lgt = lgt / (10 ^ multi)
        decimalChr = String(multi, "0")
 
    End If
 
	If lgt < 10 Then
		tmplocation = tmplocation & String(Len(tmplocation) - p1, "0")
	End If
 
    If fg_direction Then
        ' Latitude
        If lgt < -90 Or lgt > 90 Then
            If Not fg_check Then
                result = result & part
            End If
            result = result & " Lat. is not in range (-90° + 90°),"
        End If
    Else
        ' Longitude
        If lgt < -180 Or lgt > 180 Then
            If Not fg_check Then
                result = result & part
            End If
            result = result & part & " Long. is not in range (-180° + 180°),"
        End If
    End If
 
    Select Case configPC
        Case "."
            tmplocation = Format(lgt, "0." & decimalChr)
        Case ","
            tmplocation = Format(lgt, "0," & decimalChr)
    End Select
 
    Return
End Function

Pour fonctionner, la fonction à besoin d'une autre fonction

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
 
Function CheckLocationRules(CheckValue As String) As Boolean
    ' The function check if the value follow the business rules
    ' ---------------------------------------------------------
 
    Dim result As Boolean
    Dim strPattern As String
    Dim regEx As New RegExp
    Dim qt As Integer
    Dim p1 As Integer, p2 As Integer
    Dim i_comma1 As Integer, i_comma2 As Integer, i_point As Integer, i As Integer
    Dim chrStr As String, TmpStr As String
    Dim tmp1 As String, tmp2 As String
    Dim fgPoint As Boolean, fgSpace As Boolean, fgComma As Boolean
    Dim ctComma As Integer
 
    result = False
    fgPoint = False
    fgSpace = False
    fgComma = False
 
    If CheckValue <> "" Then
 
        qt = StringCountOccurrences(CheckValue, ",")
 
        If qt > 0 Then
            If qt = 1 Then
 
                ' only 1 "," founded in string
                ' Check if the coma is really the decimal separator
                ' -------------------------------------------------
 
                p1 = InStr(1, CheckValue, ",")
                If p1 > 5 Then
                    i = Len(CheckValue)
 
                    Do
                        GoSub GetAscII
 
                        i = i - 1
                    Loop Until p2 = 44 Or i = 0
 
                    If Not fgPoint Then
                        result = False  ' the " , " is not the decimal separator
                    Else
                        '
                        CheckValue = Trim(Left(CheckValue, i)) & ", " & Trim(Mid(CheckValue, i + 2, Len(CheckValue) - (i + 1)))
                        result = True
                    End If
                Else
                    ' Case of one number
                    result = True
                End If
 
            ElseIf qt = 2 Then
                i = Len(CheckValue)
                ctComma = 0
 
                Do
                    GoSub GetAscII
                    If fgComma And Not IsNumeric(chrStr) And chrStr <> "-" Then
                        ctComma = ctComma + 1
                    End If
                    i = i - 1
                Loop Until ctComma = 2 Or i = 0
                If Not fgPoint And ctComma = 2 Then
                    If fgSpace Then
                        tmp1 = Trim(Left(CheckValue, i - 1))
                        tmp2 = Trim(Mid(CheckValue, i + 1, Len(CheckValue) - i))
                    Else
                        tmp1 = Trim(Left(CheckValue, i))
                        tmp2 = Trim(Mid(CheckValue, i + 2, Len(CheckValue) - i))
                    End If
 
                    result = True
                ElseIf fgPoint And fgComma Then
                    If i_comma2 > 0 And i_comma2 <= 5 Then
                        tmp1 = Trim(Left(CheckValue, i_comma1 - 1))
                        tmp2 = Trim(Mid(CheckValue, i_comma1 + 1, Len(CheckValue) - i_comma1))
                        result = True
                    Else
                        ' in this case, the decimal separator is "."
                        result = False
                    End If
                ElseIf fgPoint Then
                    ' in this case, the decimal separator is "."
 
                    result = False
                End If
                CheckValue = tmp1 & ", " & tmp2
 
            ElseIf qt = 3 Then
                i = Len(CheckValue)
                ctComma = 0
 
                Do
                    GoSub GetAscII
                    If fgComma And Not IsNumeric(chrStr) And chrStr <> "-" And chrStr <> " " And chrStr <> "+" Then
                        ctComma = ctComma + 1
                    End If
                    i = i - 1
                Loop Until ctComma = 2 Or i = 0
 
                If i_comma2 > 0 Then
                    tmp1 = Trim(Left(CheckValue, i_comma2 - 1))
                    tmp2 = Trim(Mid(CheckValue, i_comma2 + 1, Len(CheckValue) - i_comma2))
                End If
                CheckValue = tmp1 & ", " & tmp2
                result = True
            End If
        Else
            result = True
        End If
 
        If result Then
            strPattern = "(^[-]?[1]?\d{1,2}[\.|\,]\d{2,})"
            strPattern = strPattern & "([\,]{0,1}[\s]?[-]?[1]?\d{1,2}[\.|\,]\d{2,})?"
            strPattern = strPattern & "$"
 
            With regEx
                .Global = False
                .MultiLine = False
                .IgnoreCase = False
                .Pattern = strPattern
            End With
 
            result = regEx.test(CheckValue)
        End If
    End If
    CheckLocationRules = result
    Exit Function
 
GetAscII:
    chrStr = Mid(CheckValue, i, 1)
 
    Select Case chrStr
        Case "."
            fgPoint = True
            i_point = i
        Case " "
            fgSpace = True
        Case ","
            If Not fgComma Then
                i_comma1 = i        ' position of most right
            Else
                i_comma2 = i        ' position of most left
            End If
            fgComma = True
    End Select
 
    p2 = Asc(chrStr)
    Return
End Function

Le principe de base:

J'essaie de savoir si la chaine de caractères possède la "," et donc plusieurs valeurs.

Dans le cas d'une valeur, j'appelle le sous programme de contrôle et vérifie que la valeur soit bien dans les normes en fonction de (longitude / latitude)
Dans le cas de plusieurs valeurs, je parse la chaine, j'extrais la valeur numérique et j'appelle le sous-programme de contrôle.
Je recommence tant que je trouve une virgule. (C'est ici aussi mon problème pour certain pays).
Comment savoir si la "," que je trouve est un séparateur de VALEUR ou un séparateur DECIMALE ?

Le sous-programme contrôlant la valeur:

Vu que je ne sais pas dans quel configuration que je suis, je:

a) calcule la position du caractère de séparation des décimale
b) reconstruit le nombre pour obtenir une valeur "naturel" sur la machine sur lequel je suis.
Si la config est le ".", naturellement il reconstruira le nombre avec le "."
Même chose si la machine travaille avec la ","
(Je n'emploie pas CDBL ou autre fonction de conversion - cela ne fonctionne pas pour tout le monde)

c) je contrôle la valeur numérique !

Comme vous le voyez, cela devient une usine à gaz !
Je ne sais plus quoi faire.

Si quelqu'un parmis vous a une idée ?
Vous seriez mon Graal !

Grand merci déjà d'avance pour votre aide éventuelle
Bonne journée
André

**Pierre Fauconnier** · 08/04/2021, 15h27

Salut.

Perso, j'imposerais une normalisation de saisie.

La "norme" internationale est le . comme séparateur décimal. Du coup, j'imposerai le format 123.45,456.78 pour saisir les valeurs 123.45 et 456.78 dans la même cellule et je rejetterais les saisies erronées sur base de ce "pattern"...

**dede_bo** · 08/04/2021, 15h44

Bonjour Pierre Fauconnier,
Merci pour votre réaction rapide.

Votre idée n'est pas mauvaise.
Mais, comment faire accepter au système utilisant la "," comme caractère séparateur de décimal le "." ?
Dès que j'arriverais sur l'instruction qui doit extraire la valeur numérique, il y aura un crash du VBA avec type Mistmach !

Bien à vous
André

**Pierre Fauconnier** · 08/04/2021, 16h03

Je propose le . comme séparateur décimal car c'est la norme informatique habituellement admise. Le VBA est un peu capricieux à ce niveau-là, d'où l'exigence d'une norme.

Si la norme est respectée, le problème se réduit à un split et une transformation de donnée. Soit la vérification est effectuée avant le split (par exemple avec une expression régulière), soit après sur chaque coordonnée...

**dede_bo** · 08/04/2021, 16h07

Bonjour,

Bonne idée
Je vais essayer... je vais vite faire une petite fonction de test ..
Je vous tiens informé

Merci

**dede_bo** · 09/04/2021, 22h36

Bonjour,

J'ai fait les modifications, j'ai envoyé le fichier a plusieurs personnes ayant des configurations différentes.
C'est en cours de tests.

Merci de votre soutient.
Je vous tiens informé de l'évolution de la situation.

Bonne soirée
André

**dede_bo** · 12/04/2021, 14h17

Bonjour à tous,

J'ai trouvé la solution grâce à votre aide (Mr Fauconnier).
Je ne sais comment vous remercier!

Pour celles & ceux qui sont intéressés, je donne le fichier contenant la macro.
Laisser juste le copyright dans la fonction svp.

CheckValue.xlsm

Je viens d'essayer le fichier que j'ai mis ici.

Si vous avez le souci : 2x Disable macros

Nom : VBA_Forum2.jpg
Affichages : 59
Taille : 60,6 Ko

Nom : VBA_Forum2.jpg
Affichages : 59
Taille : 60,6 Ko

Voici la procédure pour le résoudre:
1°) enregistrer le fichier sur votre ordinateur
2°) ouvrez Outlook et créer un mail
3°) n'encoder aucune adresse mail ni aucun sujet
4°) attacher le fichier concerné.
5°) sauvegarder le fichier attaché

Problème résolu

Bien à vous.

André

Contrôle de longitude / latitude [XL-2016]

Macros et VBA Excel

Discussions similaires

Partager

Partager