Koordinat Dönüştürücü

[mahmut_m72]

Arkadaşlar aşğıdaki kodu chatgptye yazdırdım ama yanlış sonuç veriyor kontrol edebilecek olan varmı, ben nerde hata verdiğini bulamadım

Function UTMToWGS84(Easting As Double, Northing As Double, zoneNumber As Integer, isNorthernHemisphere As Boolean) As Variant
' WGS84 elipsoid parametreleri
Const a As Double = 6378137 ' Yarı büyük eksen (metre)
Const f As Double = 1 / 298.257223563 ' Basıklık
Const k0 As Double = 0.9996 ' Ölçek faktörü

' Elipsoidin diğer parametreleri
Dim b As Double
Dim e As Double
Dim e1sq As Double

b = a * (1 - f) ' Yarı küçük eksen
e = Sqr((a ^ 2 - b ^ 2) / a ^ 2) ' Elipsoidin eksantrikliği
e1sq = e ^ 2 / (1 - e ^ 2) ' Elipsoidin eksantrikliğinin karesi

' Orijin meridyeninin boylamı
Dim lonOrigin As Double
lonOrigin = (zoneNumber - 1) * 6 - 180 + 3

' Kuzey-Güney ayrımı
If Not isNorthernHemisphere Then
Northing = Northing - 10000000
End If

' Meridyen ark uzunluğu hesaplaması
Dim M As Double
M = Northing / k0

' Ayarlanmış Meridyen ark uzunluğu
Dim mu As Double
mu = M / (a * (1 - e ^ 2 / 4 - 3 * e ^ 4 / 64 - 5 * e ^ 6 / 256))

' ?1 hesaplaması
Dim phi1Rad As Double
phi1Rad = mu + (3 * e1sq / 2 - 27 * e1sq ^ 3 / 32) * Sin(2 * mu) _
+ (21 * e1sq ^ 2 / 16 - 55 * e1sq ^ 4 / 32) * Sin(4 * mu) _
+ (151 * e1sq ^ 3 / 96) * Sin(6 * mu)

' Dönüşüm
Dim N1 As Double
Dim T1 As Double
Dim C1 As Double
Dim R1 As Double
Dim D As Double

N1 = a / Sqr(1 - e ^ 2 * Sin(phi1Rad) ^ 2)
T1 = Tan(phi1Rad) ^ 2
C1 = e1sq * Cos(phi1Rad) ^ 2
R1 = a * (1 - e ^ 2) / (1 - e ^ 2 * Sin(phi1Rad) ^ 2) ^ (3 / 2)
D = (Easting - 500000) / (N1 * k0)

' Enlem hesaplaması
Dim lat As Double
lat = phi1Rad - (N1 * Tan(phi1Rad) / R1) * (D ^ 2 / 2 - (5 + 3 * T1 + 10 * C1 - 4 * C1 ^ 2 - 9 * e1sq) * D ^ 4 / 24 + (61 + 90 * T1 + 298 * C1 + 45 * T1 ^ 2 - 252 * e1sq - 3 * C1 ^ 2) * D ^ 6 / 720)
lat = lat * 180 / WorksheetFunction.Pi ' Radyanları dereceye çevir

' Boylam hesaplaması
Dim lon As Double
lon = (D - (1 + 2 * T1 + C1) * D ^ 3 / 6 + (5 - 2 * C1 + 28 * T1 - 3 * C1 ^ 2 + 8 * e1sq + 24 * T1 ^ 2) * D ^ 5 / 120) / Cos(phi1Rad)
lon = lonOrigin + lon * 180 / WorksheetFunction.Pi ' Radyanları dereceye çevir

UTMToWGS84 = Array(lat, lon)
End Function

Sub ConvertUTMToWGS84()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Elevation") ' Sayfa adını gerektiği gibi değiştirin

' AC6 ve AD6 hücrelerindeki UTM koordinatlarını al
Dim xUTM As Double
Dim yUTM As Double
Dim zoneNumber As Integer
Dim isNorthernHemisphere As Boolean

xUTM = ws.Range("AC6").Value
yUTM = ws.Range("AD6").Value
zoneNumber = ws.Range("AE6").Value ' Zone numarasını AE6 hücresinden al
isNorthernHemisphere = True ' Türkiye kuzey yarıkürede yer alır

' UTM koordinatlarını WGS84'e dönüştür
Dim result As Variant
result = UTMToWGS84(xUTM, yUTM, zoneNumber, isNorthernHemisphere)

' WGS84 koordinatlarını AC3 ve AD3 hücrelerine yaz
ws.Range("AC3").Value = result(0) ' Latitude
ws.Range("AD3").Value = result(1) ' Longitude
End Sub

 

[Tevfik_Kursun]

Merhaba Arkadaşım,
Siz burada ne arıyorsunuz? Gelen AC3=0, AD3=-187,489 bu değerler nedir?
İyi çalışmalar

 

[Haluk]

Excel'de koordinat çevirme

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

www.excel.web.tr

.

 

[Tevfik_Kursun]

Teşekkürler Haluk Hocam,
Şimdi anladım arkadaşın ne yapmak istediğini
Saygılarımla

 

[mahmut_m72]

Sorunumu çözdüm arkadaşlar teşekkür ederim

 

[k0081]

Excel'de koordinat çevirme

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

www.excel.web.tr

.

Arkadaşlar buradaki dosyayı paylaşabilirmisiniz. Benzer bir konu vardı. Bu çözüm olabilir.

 

[Tevfik_Kursun]

Silinebilir bağlantı Ornekler
Buyrun ...

 

[k0081]

@Tevfik_Kursun

Teşekkür ederim.

 

[Tevfik_Kursun]

Rica ederim