Txt dosyasından (Gps) verisi almak

[k0081]

Merhaba arkadaşlar;

aşağıdaki örnek dosyadan ;

Hata indir

Hata

www.dosyaupload.com

dosya yolu : C:\örnek.txt

belirtmiş olduğum şekilde yani ayıraç olarak değerler arasında virgül kullanarak 3 adet veriyi msgbox da nasıl alabilirim

GPS Latitude
değişken1 : 40,51,8.62

GPS Longitude

değişken2 : 31,14,35.72

GPS Altitude

değişken3 : 218.2141264 m


yardımcı arkadaşa şimdiden teşekkürler.

 

[muygun]

Merhaba;
Eki deneyin.
İyi çalışmalar.

Not: örnek.txt dosyası C:\ de olmalı

Link:
https://www.dosya.tc/server39/207m6j/k0081-txt_getir.zip.html

 

[veyselemre]

Alternatif olsun,

Sub test()
    Dim bulunan$(1 To 3), textLine$, fName$
    
    fName = ThisWorkbook.Path & "\örnek.txt"
    
    If Dir(fName) <> "" Then
    
        Open fName For Input As #1
        Do While Not EOF(1)
            Line Input #1, textLine
            If textLine Like "GPS Latitude*" And Not textLine Like "*Ref*" Then
                bulunan(1) = Replace(Replace(Replace(Trim(Split(textLine, ":")(1)), " deg ", ","), "' ", ","), """", "")
            End If
            If textLine Like "GPS Longitude*" And Not textLine Like "*Ref*" Then
                bulunan(2) = Replace(Replace(Replace(Trim(Split(textLine, ":")(1)), " deg ", ","), "' ", ","), """", "")
            End If
            If textLine Like "GPS Altitude*" And Not textLine Like "*Ref*" Then
                bulunan(3) = Trim(Split(textLine, ":")(1))
            End If
        Loop
        Close #1
    
    End If
    
    MsgBox "GPS Latitude" & vbLf & "değişken1 : " & bulunan(1) & vbLf & vbLf & "GPS Longitude" & vbLf & "değişken2 : " & bulunan(2) & vbLf & vbLf & "GPS Altitude" & vbLf & "değişken3 : " & bulunan(3)
End Sub

 

[k0081]

Sn muygun

dosyayı indirdim fakat çalıştıramadım. makro güvenliği ile ilgili bir hata aldım... pembe renkli bir bar şeklinde..

Makro güvenliğini açıp denedim. yine çalıştıramadım.

* sadece makro kodlarını paylaşabilirmisiniz.


Çok teşekkür ediyorum.


***************************************************

Tamamdır. Dosyayı farklı kaydederek çalıştırdım. Elinize sağlık.

 

[k0081]

Sn. veyselemre

Çalışma için çok Teşekkür ederim. Tamamdır. elinize sağlık.

 

[muygun]

* sadece makro kodlarını paylaşabilirmisiniz.

Sub işlem()
Range("a1:b65536").ClearContents
sat = 1
fname = "C:\örnek.txt"
If Dir(fname) <> "" Then
Cells.ClearContents
Open fname For Input As #1
Do While Not EOF(1)
Line Input #1, textline
textline = Trim(textline)
If textline <> "" Then
sat = sat + 1
a = Split(textline, ",")
sut = 1
For Each s In a
If (sut = 3 Or sut = 4) And IsNumeric(s) Then
Cells(sat, sut) = Val(s) / 10
Else
Cells(sat, sut) = s
End If
sut = sut + 1
Next s
End If
Loop
Close #1
End If


For i = 1 To Range("A65536").End(xlUp).Row

If Left(Cells(i, 1), 34) = "GPS Latitude : " Then
uzz1 = Len(Cells(i, 1))
all1 = uzz1 - 34
bulunan1 = Right(Cells(i, 1), all1)
bulunan1 = Replace(bulunan1, " deg ", ",")
bulunan1 = Replace(bulunan1, "' ", ",")
bulunan1 = Replace(bulunan1, """", "")
End If

If Left(Cells(i, 1), 34) = "GPS Longitude : " Then
uzz2 = Len(Cells(i, 1))
all2 = uzz2 - 34
bulunan2 = Right(Cells(i, 1), all2)
bulunan2 = Replace(bulunan2, " deg ", ",")
bulunan2 = Replace(bulunan2, "' ", ",")
bulunan2 = Replace(bulunan2, """", "")
End If

If Left(Cells(i, 1), 34) = "GPS Altitude : " Then
uzz3 = Len(Cells(i, 1))
all3 = uzz3 - 34
bulunan3 = Right(Cells(i, 1), all3)
bulunan3 = Replace(bulunan3, " deg ", ",")
bulunan3 = Replace(bulunan3, "' ", ",")
bulunan3 = Replace(bulunan3, """", "")
End If

Next i
Range("a1:b65536").ClearContents

MsgBox "GPS Latitude" & vbLf & "değişken1 : " & bulunan1 & vbLf & vbLf & "GPS Longitude" & vbLf & "değişken2 : " & bulunan2 & vbLf & vbLf & "GPS Altitude" & vbLf & "değişken3 : " & bulunan3
End Sub

 

[k0081]

muygun


Teşekkür ederim.