XL 2019 transformation de cordonnée GPS

[nawak83]

Bonsoir la communauté,

Je reçois des coordonnées dans un fichier excel sous cette forme : N323536 dans la colonne A et E0363636 dans la colonne B.
je souhaiterai copier les colonne A et B de ce fichier et les envoyer dans les colonne D et E d'un autre fichier tout en les convertissant sous cette forme N 32°35'36".000 E 036°36'36".000

j'ai reussi ce code qui me permet de séparer le N ou S et E ou W des chiffre, mais je ne sais pas comment faire le reste

voici mon code

Columns("B:C").Select

Selection.Replace What:="N", Replacement:="N ", LookAt:=xlPart, _
       SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=True, _
       ReplaceFormat:=False

Selection.Replace What:="E0", Replacement:="E 0", LookAt:=xlPart, _
       SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=True, _
       ReplaceFormat:=False

Selection.Replace What:="W", Replacement:="W 0", LookAt:=xlPart, _
       SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=True, _
       ReplaceFormat:=False
      
Selection.Replace What:="S", Replacement:="S ", LookAt:=xlPart, _
       SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=True, _
       ReplaceFormat:=False

En vous remerciant par avance.

Bonne soirée

 

[sylvanu]

Bonsoir Nawak,
Un essai en PJ avec la fonction perso :

Function Conversion(C$)
' N323536  en N 32°35'36".000
' E0363636  en E 036°36'36".000
    Nombre = Val(Mid(C, 2))
    Entete = Left(C, 1)
    Part1 = Left(Right(Trim(C), 4), 2)
    Part2 = Left(Right(Trim(C), 6), 2)
    Part3 = Right(Trim(C), 2)
    If Entete = "N" Or Entete = "S" Then
        Conversion = Entete & " " & Part1 & "°" & Part2 & "'" & Part3 & """.000"
    Else
        Conversion = Entete & " 0" & Part1 & "°" & Part2 & "'" & Part3 & """.000"
    End If
End Function

 

[nawak83]

merci pour ta réponse.
effectivement cela fonction pour une case, mais comment je peux l'assigner a plusieurs case en VBA

 

[sylvanu]

C'est une fonction perso. Regardez en D2 E2.
La syntaxe est =Conversion(B2) et =Conversion(C2)
C'est une fonction qui est utilisable comme toute fonction XL.

 

[nawak83]

ha oui autant pour moi DSL.
2tant données que je suis en train de faire une grosse macro pour récupérer une multitude de données, je souhaiterai que juste après la copie cela convertisse mes données.
De plus a chaque fois le nombre de ligne change.

 

[sylvanu]

Vous pouvez l'utiliser comme toute fonction, par ex :

Sub Essai()
    Chaine1 = "N323536"
    Chaine2 = "E0363636"
    Range("B5") = Chaine1
    Range("C5") = Chaine2
    Range("D5") = Conversion(Chaine1)
    Range("E5") = Conversion(Chaine2)
End Sub
Function Conversion(C)
' N323536  en N 32°35'36".000
' E0363636  en E 036°36'36".000
    Nombre = Val(Mid(C, 2))
    Entete = Left(C, 1)
    Part1 = Left(Right(Trim(C), 4), 2)
    Part2 = Left(Right(Trim(C), 6), 2)
    Part3 = Right(Trim(C), 2)
    If Entete = "N" Or Entete = "S" Then
        Conversion = Entete & " " & Part1 & "°" & Part2 & "'" & Part3 & """.000"
    Else
        Conversion = Entete & " 0" & Part1 & "°" & Part2 & "'" & Part3 & """.000"
    End If
End Function

( attention j'ai retiré le $ de C$ dans la fonction. )

 

[nawak83]

merci
un exemple vos mieux que de bel phrase.
dans mon tableau ci-joint j'ai remplis plusieurs coordonnées, comment je peux modifier votre code VBA pour que cela ce fasse tout seul?

 

[sylvanu]

Sub Essai()
    Application.ScreenUpdating = False
    Set Plage = Range("D2:E" & Range("B65500").End(xlUp).Row)
    Plage.FormulaLocal = "=Conversion(B2)"
    Plage.Formula = Plage.Value
End Sub

 

[sylvanu]

Re, Bonjour Bruno,
Nawak va peut être s'expliquer.

Mais comme j'avais déjà optimisé, et que ça pourra servir aux futurs lecteurs, je livre quand même.
En PJ une seconde solution sans fonction, mais une seule macro et un array. C'est plus rapide.
Sur mon vieux PC avec 50 000 lignes :
La macro avec fonction prend 3s.
La macro avec array prend 0.75s.

Sub EssaiParSub()
    T0 = Timer
    Dim Tablo, TabloSortie
    [D:E].ClearContents
    Application.ScreenUpdating = False
    Tablo = Range("B2:C" & Range("B65500").End(xlUp).Row)
    ReDim TabloSortie(UBound(Tablo), 1)
    For i = 1 To UBound(Tablo)
        For C = 1 To 2
            Nombre = Val(Mid(Tablo(i, C), 2))
            Entete = Left(Tablo(i, C), 1)
            Part1 = Left(Right(Trim(Tablo(i, C)), 4), 2)
            Part2 = Left(Right(Trim(Tablo(i, C)), 6), 2)
            Part3 = Right(Trim(Tablo(i, C)), 2)
            Valeur = Entete & " " & Part1 & "°" & Part2 & "'" & Part3 & """.000"
            If Entete = "E" Or Entete = "W" Then
                Valeur = Left(Valeur, 2) & "0" & Mid(Valeur, 3)
            End If
            TabloSortie(i - 1, C - 1) = Valeur
        Next C
    Next i
    [D2].Resize(UBound(TabloSortie, 1), 1 + UBound(TabloSortie, 2)) = TabloSortie
    [I6] = Format(Timer - T0, "0.000s")
End Sub

 

[nawak83]

bonjour,
Je te remercie pour la réponse.

Concernant la cross-posting, oui un peu pressé, je suis désolé, je ne recommencerai plus.

Je vous remercie pour toutes vos informations transmises sur ce forum.

 

[nawak83]

Re, Bonjour Bruno,
Nawak va peut être s'expliquer.

Mais comme j'avais déjà optimisé, et que ça pourra servir aux futurs lecteurs, je livre quand même.
En PJ une seconde solution sans fonction, mais une seule macro et un array. C'est plus rapide.
Sur mon vieux PC avec 50 000 lignes :
La macro avec fonction prend 3s.
La macro avec array prend 0.75s.

Sub EssaiParSub()
    T0 = Timer
    Dim Tablo, TabloSortie
    [D:E].ClearContents
    Application.ScreenUpdating = False
    Tablo = Range("B2:C" & Range("B65500").End(xlUp).Row)
    ReDim TabloSortie(UBound(Tablo), 1)
    For i = 1 To UBound(Tablo)
        For C = 1 To 2
            Nombre = Val(Mid(Tablo(i, C), 2))
            Entete = Left(Tablo(i, C), 1)
            Part1 = Left(Right(Trim(Tablo(i, C)), 4), 2)
            Part2 = Left(Right(Trim(Tablo(i, C)), 6), 2)
            Part3 = Right(Trim(Tablo(i, C)), 2)
            Valeur = Entete & " " & Part1 & "°" & Part2 & "'" & Part3 & """.000"
            If Entete = "E" Or Entete = "W" Then
                Valeur = Left(Valeur, 2) & "0" & Mid(Valeur, 3)
            End If
            TabloSortie(i - 1, C - 1) = Valeur
        Next C
    Next i
    [D2].Resize(UBound(TabloSortie, 1), 1 + UBound(TabloSortie, 2)) = TabloSortie
    [I6] = Format(Timer - T0, "0.000s")
End Sub

Bonsoir

Encore une fois merci pour ta réponse
Je rencontre un problème avec ta macro, elle modifie les coordonnées. Je m'explique si par exemple N 444546 en entrée, en sortie j'aurai N 44°50'30".
Je ne parviens pas à identifier le problème.
Je vous remercie par avance
bonne soirée

 

[nawak83]

Bonsoir
Merci pour votre réponse.
Est-ce que vous auriez la même chose mais en vba?
Je m'explique, c'est coordonne vienne d'un autre fichier. Elles sont copie collé dans mes colonnes via une macro et je souhaiterai que l'orque elles sont collé dans mon fichier de destination elle soit transformer au bon format.

En vous remerciant par avance
Bonne soirée

 

[sylvanu]

Bonsoir Nawak,
Oups ! J'ai vu. En PJ c'est corrigé.
Avec N123456 je faisais 34 12 56 au lieu de 12 34 56.
Mille excuses.

 

[nawak83]

Bonjour Sylvanu,

Merci beaucoup pour ta réponse, cela va grandement m'aider!
est-ce que je peux solliciter encore une fois ton aide?
J'ai fais un autre poste sur la conversion des degrés décimaux en degrés minutes seconde en vba, pourrais-tu m'aider?
Bonne journée a tous

 

[sylvanu]

Impec.
De mémoire minutes=60×decimaux/100
Mais faites un post vous aurez plein de réponses.