XL 2019 transformation de cordonnée GPS

nawak83

XLDnaute Nouveau
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
VB:
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
 
Solution
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.

Code:
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 =...

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonsoir Nawak,
Un essai en PJ avec la fonction perso :
VB:
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
 

Pièces jointes

  • Nawak.xlsm
    14 KB · Affichages: 4

nawak83

XLDnaute Nouveau
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

XLDnaute Barbatruc
Supporter XLD
Vous pouvez l'utiliser comme toute fonction, par ex :
VB:
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. )
 

Pièces jointes

  • Nawak (2).xlsm
    15.8 KB · Affichages: 2

sylvanu

XLDnaute Barbatruc
Supporter XLD
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.

Code:
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
 

Pièces jointes

  • Nawak (4).xlsm
    499.5 KB · Affichages: 8

nawak83

XLDnaute Nouveau
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.

Code:
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

XLDnaute Nouveau
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
 

nawak83

XLDnaute Nouveau
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
 

Discussions similaires

Statistiques des forums

Discussions
311 724
Messages
2 081 936
Membres
101 844
dernier inscrit
pktla