Excel'de koordinat çevirme

[hadromer]

Merhaba,
aşağıdaki fotoğrafta görülen koordinatları dakika derece cinsine çevirmek istiyorum. bunun basit bir yolu var mıdır ? internette çeviri siteleri var fakat tek tek çevirmek gerekiyor. Yardımlarınız için şimdiden teşekkür ederim.
ÖRNEK DOSYA

 

[Haluk]

......... koordinatları dakika derece cinsine çevirmek istiyorum. bunun basit bir yolu var mıdır ?

Basit yolu var ..... desimal koordinatları 24'e bölüp, hücreleri biçimlendirin.

Örnek dosya ektedir....

.

 

[hadromer]

Basit yolu var ..... desimal koordinatları 24'e bölüp, hücreleri biçimlendirin.

Örnek dosya ektedir....

.

Hocam öncelikle teşekkür ederim. denedim fakat fotoğrafta göründüğü üzere Benim istediğime uygun bir sonuç vermiyor Başka bir yol bulabilir miyiz ?

 

[Merhum İdris SERDAR]

.

Nasıl sonuçlar bekliyorsunuz? Bir kaç örnek verir misiniz?

.

 

[Haluk]

Hocam öncelikle teşekkür ederim. denedim fakat fotoğrafta göründüğü üzere Benim istediğime uygun bir sonuç vermiyor Başka bir yol bulabilir miyiz ?

Hangi fotoğraf ???

Bu arada, sizin desimal koordinatlarda tuhaflık var..... o kadar büyük değerler olamaz.

Koordinat verilerinin alabileceği sınır değerler;

-90,000000 < Enlem < 90,000000

-180,000000 < Boylam < 180,000000

.

 

[Zeki Gürsoy]

Araştırdığım kadarıyla UTM koordinatlarına benziyor.

 

[Haluk]

Soruyu sorandan açıklama gelene kadar ben bir şey ilave etmeyeceğim..... Ondan sonra, ".... gereksiz yere konu uzuyor" diye lâf ediliyor.

.

 

[hadromer]

özür dileyerek cevaplamak istiyorum. yoğunluğumdan dolayı ancak bakabiliyorum affınıza sığınıyorum. Fotoğrafı yüklemeyi de unutmuşum. Haluk Bey'in verdiği dosyayı kullandığımda böyle bir sonuç çıkıyor. Sanırım bendeki kodlar UTM veya Ed50. Ben bunu ondalık veya derece dakika cinsine çevirmek istiyorum. ondalıkta örneğin 40.234256 gibi bir sonuç çıkması lazım.

 

[hadromer]

http://www.rapsim.bilgem.tubitak.gov.tr/kconverter.php bu site tubitakın çeviri sitesi . burdan fotoğraftaki gibi çeviri yapılabiliyor. işime yarayan bir sonuç burdan çevrilen formatı google earth ve google maps tanıyor. Ama bunu tek tek yapmak oldukça yorucu.

 

[Haluk]

Aşağıdaki resimde belirtilen değerler, sizinkiyle uyumlu sanırım....

Ekli dosyayı ihtiyacınıza göre düzenleyerek kullanabilirsiniz.




.

 

[hadromer]

Aşağıdaki resimde belirtilen değerler, sizinkiyle uyumlu sanırım....

Ekli dosyayı ihtiyacınıza göre düzenleyerek kullanabilirsiniz.


Ekli dosyayı görüntüle 211015

.

Çok teşekkür ederim, istediğim buydu.

 

[ÖmerFaruk]

Ben de bu konu üzerinde epeydir uğraşıyordum. Dosyamın son halindeki kodları paylaşmak istedim. Çok kullanışlıdır.
WGS84 - EDM50 dönüşümlerini karşılıklık olarak yapabilir,
Zone numarasını otomatik bulabilirsiniz.
Ayrıca Derece-radyan ya da Ondalık gösterimden DMS gösterimine otomatik geçebilrisiniz.
Her biriyle alakalı fonksiyonlar tanımlanmıştır.
Ben kullanım olarak Eklenti Dosyam (*.xla) içinde direktayrı bir modül içinde kullanıyorum. Tüm excel dosyalarımda gerektiğinde kullanabiliyorum.

Option Explicit

'  ---- GENEL SABİT SAYILAR ----------------------------------------------------
' pi sayısı
Public Const pi As Double = 3.14159265358979
' ED50 elipsoidi parametreleri
Public Const ED50_a As Double = 6378388            ' Yarı büyük eksen (m)
Public Const ED50_f As Double = 1 / 297             ' Yassılaşma
' WGS84 elipsoidi parametreleri
Public Const WGS84_a As Double = 6378137            ' Yarı büyük eksen (m)
Public Const WGS84_f As Double = 1 / 298.257223563  ' Yassılaşma
' Helmert dönüşüm parametreleri ED50 -> WGS84 (metrik ve saniye cinsinden)
Public Const DX As Double = -87      ' X ofset (m)
Public Const DY As Double = -96      ' Y ofset (m)
Public Const DZ As Double = -120     ' Z ofset (m)
Public Const RX_SEC As Double = 0    ' X ekseninde dönüş açısı (saniye)
Public Const RY_SEC As Double = 0    ' Y ekseninde dönüş açısı (saniye)
Public Const RZ_SEC As Double = 0    ' Z ekseninde dönüş açısı (saniye)
Public Const DS As Double = 0        ' Ölçek farkı (ppm)

' ---- YARDIMCI FONKSİYONLAR ----------------------------------
' Derece -> Radyan
Public Function DegToRad(deg As Double) As Double
    DegToRad = deg * pi / 180#
End Function
' Radyan -> Derece
Public Function RadToDeg(rad As Double) As Double
    RadToDeg = rad * 180# / pi
End Function
' Yardımcı fonksiyon: atan2 (iki argümanlı arktanjant)
Public Function Atn2(Y As Double, X As Double) As Double
    If X > 0 Then
        Atn2 = Atn(Y / X)
    ElseIf X < 0 And Y >= 0 Then
        Atn2 = Atn(Y / X) + pi
    ElseIf X < 0 And Y < 0 Then
        Atn2 = Atn(Y / X) - pi
    ElseIf X = 0 And Y > 0 Then
        Atn2 = pi / 2
    ElseIf X = 0 And Y < 0 Then
        Atn2 = -pi / 2
    Else
        Atn2 = 0
    End If
End Function
' Küçük açı saniyesini radyana çevir
Public Function SecToRad(sec As Double) As Double
    SecToRad = sec * (pi / (180# * 3600#))
End Function

' Helmert dönüşüm parametrelerini radyana çevir
' Asıl yordamlar içinde kullanılıyor.
Public Function GetRotationRadians() As Variant
    Dim rotations(1 To 3) As Double
    rotations(1) = SecToRad(RX_SEC)
    rotations(2) = SecToRad(RY_SEC)
    rotations(3) = SecToRad(RZ_SEC)
    GetRotationRadians = rotations
End Function

' ----- ASIL YORDAMLAR ------------------------------------------------------------------------------------------
' ED50 Lat/Lon --> WGS84 Lat/Lon dönüşümü (Helmert dönüşümü)
Public Sub ED50toWGS84(Latitude As Double, Longitude As Double, ByRef OutLat As Double, ByRef OutLon As Double)
    Dim latRad As Double: latRad = DegToRad(Latitude)
    Dim lonRad As Double: lonRad = DegToRad(Longitude)
   
    Dim e2 As Double: e2 = 2 * ED50_f - ED50_f ^ 2
    Dim N As Double: N = ED50_a / Sqr(1 - e2 * Sin(latRad) ^ 2)
   
    ' ED50 ECEF koordinatları
    Dim X As Double, Y As Double, Z As Double
    X = N * Cos(latRad) * Cos(lonRad)
    Y = N * Cos(latRad) * Sin(lonRad)
    Z = N * (1 - e2) * Sin(latRad)
   
    ' Helmert dönüşüm parametreleri
    Dim rotations As Variant
    rotations = GetRotationRadians()
    Dim rx As Double, ry As Double, rz As Double
    rx = rotations(1)
    ry = rotations(2)
    rz = rotations(3)
   
    Dim ds_factor As Double
    ds_factor = 1 + DS * 0.000001 ' ppm to scale factor
   
    ' Helmert dönüşümü uygulama
    Dim X2 As Double, Y2 As Double, Z2 As Double
    X2 = DX + ds_factor * (X + (-rz) * Y + ry * Z)
    Y2 = DY + ds_factor * (rz * X + Y + (-rx) * Z)
    Z2 = DZ + ds_factor * ((-ry) * X + rx * Y + Z)
   
    ' WGS84 elipsoidi parametreleri
    Dim a_wgs As Double: a_wgs = WGS84_a
    Dim f_wgs As Double: f_wgs = WGS84_f
    Dim e2_wgs As Double: e2_wgs = 2 * f_wgs - f_wgs ^ 2
   
    ' ECEF'den enlem ve boylama dönüşüm (WGS84)
    Dim p As Double: p = Sqr(X2 ^ 2 + Y2 ^ 2)
    Dim theta As Double
    Dim lat_wgs As Double, lon_wgs As Double
    lon_wgs = Atn2(Y2, X2)
   
    theta = Atn2(Z2 * a_wgs, p * (1 - f_wgs) * a_wgs)
    lat_wgs = Atn2(Z2 + e2_wgs * (1 - f_wgs) * a_wgs * Sin(theta) ^ 3, p - e2_wgs * a_wgs * Cos(theta) ^ 3)
   
    OutLat = RadToDeg(lat_wgs)
    OutLon = RadToDeg(lon_wgs)
End Sub

' WGS84 Lat/Lon --> ED50 Lat/Lon dönüşümü (Helmert dönüşümü ters)
Public Sub WGS84toED50(Latitude As Double, Longitude As Double, ByRef OutLat As Double, ByRef OutLon As Double)
    Dim latRad As Double: latRad = DegToRad(Latitude)
    Dim lonRad As Double: lonRad = DegToRad(Longitude)
    Dim e2 As Double: e2 = 2 * WGS84_f - WGS84_f ^ 2
    Dim N As Double: N = WGS84_a / Sqr(1 - e2 * Sin(latRad) ^ 2)
   
    ' WGS84 ECEF koordinatları
    Dim X As Double, Y As Double, Z As Double
    X = N * Cos(latRad) * Cos(lonRad)
    Y = N * Cos(latRad) * Sin(lonRad)
    Z = N * (1 - e2) * Sin(latRad)
   
    ' Helmert dönüşüm parametreleri (ters)
    Dim rotations As Variant
    rotations = GetRotationRadians()
    Dim rx As Double, ry As Double, rz As Double
    rx = -rotations(1)
    ry = -rotations(2)
    rz = -rotations(3)
   
    Dim ds_factor As Double
    ds_factor = 1 / (1 + DS * 0.000001) ' ters ölçek faktörü
   
    ' Helmert dönüşümü ters uygula
    Dim X2 As Double, Y2 As Double, Z2 As Double
    X2 = ds_factor * (X - DX) + rz * (Y - DY) - ry * (Z - DZ)
    Y2 = ds_factor * (Y - DY) - rz * (X - DX) + rx * (Z - DZ)
    Z2 = ds_factor * (Z - DZ) + ry * (X - DX) - rx * (Y - DY)
   
    ' ED50 elipsoidi parametreleri
    Dim a_ed As Double: a_ed = ED50_a
    Dim f_ed As Double: f_ed = ED50_f
    Dim e2_ed As Double: e2_ed = 2 * f_ed - f_ed ^ 2
   
    ' ECEF'den enlem/boylama dönüşüm (ED50)
    Dim p As Double: p = Sqr(X2 ^ 2 + Y2 ^ 2)
    Dim theta As Double
    Dim lat_ed As Double, lon_ed As Double
    lon_ed = Atn2(Y2, X2)
   
    theta = Atn2(Z2 * a_ed, p * (1 - f_ed) * a_ed)
    lat_ed = Atn2(Z2 + e2_ed * (1 - f_ed) * a_ed * Sin(theta) ^ 3, p - e2_ed * a_ed * Cos(theta) ^ 3)
   
    OutLat = RadToDeg(lat_ed)
    OutLon = RadToDeg(lon_ed)
End Sub

' ----- FONKSİYONLAR 1 -----
' ED50 -> WGS84 Latitude
Public Function ED50toWGS84_Lat(Latitude As Double, Longitude As Double) As Double
    Dim OutLat As Double, OutLon As Double
    Call ED50toWGS84(Latitude, Longitude, OutLat, OutLon)
    ED50toWGS84_Lat = OutLat
End Function

' ----- FONKSİYONLAR 2 -----
' ED50 -> WGS84 Longitude
Public Function ED50toWGS84_Lon(Latitude As Double, Longitude As Double) As Double
    Dim OutLat As Double, OutLon As Double
    Call ED50toWGS84(Latitude, Longitude, OutLat, OutLon)
    ED50toWGS84_Lon = OutLon
End Function

' ----- FONKSİYONLAR 3 -----
' WGS84 -> ED50 Latitude
Public Function WGS84toED50_Lat(Latitude As Double, Longitude As Double) As Double
    Dim OutLat As Double, OutLon As Double
    Call WGS84toED50(Latitude, Longitude, OutLat, OutLon)
    WGS84toED50_Lat = OutLat
End Function

' ----- FONKSİYONLAR 4 -----
' WGS84 -> ED50 Longitude
Public Function WGS84toED50_Lon(Latitude As Double, Longitude As Double) As Double
    Dim OutLat As Double, OutLon As Double
    Call WGS84toED50(Latitude, Longitude, OutLat, OutLon)
    WGS84toED50_Lon = OutLon
End Function

' ----- FONKSİYONLAR 5 -----
' UTM Zone hesaplama (boylama göre)
Public Function GetUTMZone(Longitude As Double) As Integer
    GetUTMZone = Int((Longitude + 180) / 6) + 1
End Function

' ----- FONKSİYONLAR 6 -----
' Ondalık dereceyi Derece Dakika Saniye formatına çevirme
Public Function DecToDMS(degDec As Double) As String
    Dim d As Long, m As Long
    Dim s As Double
    Dim sign As String
    If degDec < 0 Then
        sign = "-"
        degDec = Abs(degDec)
    Else
        sign = ""
    End If
    d = Int(degDec)
    m = Int((degDec - d) * 60)
    s = (degDec - d - m / 60) * 3600
    DecToDMS = sign & d & "° " & m & "' " & Format(s, "0.00") & Chr(34)
End Function