Bu məqaləni izləyin və ünvan üçün enlik və uzunluq koordinatlarını əldə edə biləcəyiniz öz coğrafi alətinizi yaradın. Bu kimi çeviricilər adətən Əmlak brokerləri tərəfindən istifadə olunur.
İndi Download
Proqramı mümkün qədər tez istifadə etməyə başlamaq istəyirsinizsə, aşağıdakıları edə bilərsiniz:
Əks halda, DIY etmək istəyirsinizsə, aşağıdakı məzmunu oxuya bilərsiniz.
GUI hazırlayaq
Sizə lazım olan tək bir Excel vərəqidir və vərəqə ehtiyacınıza uyğun olaraq ad verə bilərsiniz. Bu nümunədə mən standart vərəq adı olan "Vərəq1"dən istifadə edirəm. Növbəti addım bu vərəqə lazımi başlıqları əlavə etməkdir. Girişdə şəhərətrafı ərazi, ştat, poçt indeksi və ölkə varsa, enlik və uzunluq çeviricisi ötürdüyümüz ünvan üçün dəqiq nəticə verir. Şəkildə göstərildiyi kimi, başlıqları hazırlayın. Son iki sütun kimi Enlem və Uzunluq əlavə edək. İstifadəçinin çevirməni etməsi üçün bir düyməyə də ehtiyacımız var. Beləliklə, bir Forma daxil edək və düymə kimi görünməsi üçün onu rənglə dolduraq.
Gəlin onu funksional edək
Burada təqdim olunan skript yeni modula kopyalanmalıdır. İş kitabınızı makro ilə işləyən iş kitabı faylı kimi saxlamağı unutmayın. “FindThis” alt hissəsi yeni yaratdığımız düyməyə əlavə edilməlidir.
Test edək
Ünvanı digər məlumatlarla birlikdə müvafiq sütunlara əlavə edin. Vərəqdə sadalanan bütün ünvanlar üçün en və uzun koordinatları göstərəcək makronu işə salmaq üçün düyməni vurun. Makro 2-ci sətirdən başlayacaq və boş bir sətirə çatana qədər işə davam edəcək.
Bu necə işləyir?
Skriptlə biz iki funksiya yaratdıq. Biri Lat dəyərini, digəri isə Uzun dəyəri əldə etmək üçün. FOR döngəsindən istifadə edərək biz hər bir ünvanı bu funksiyalara ötürürük və nəticəni ekranda göstəririk.
Ssenari
Function GETLAT(v_address As String, v_suburb As String, v_state As String, v_postcode As Long)
Dim URl As String, lastRow As Long
Dim xmlHttp As Object, html As Object, objResultDiv As Object, objH3 As Object, link As Object
URl = "https://maps.googleapis.com/maps/api/geocode/xml?address=" & Application.WorksheetFunction.Substitute(v_address, " ", "+") & Application.WorksheetFunction.Substitute(v_suburb, " ", "+") & Application.WorksheetFunction.Substitute(v_state, " ", "+") & Application.WorksheetFunction.Substitute(v_postcode, " ", "+") & ",Australia"
Set xmlHttp = CreateObject("MSXML2.XMLHTTP")
xmlHttp.Open "GET", URl, False
xmlHttp.setRequestHeader "Content-Type", "text/xml"
xmlHttp.send
Set html = CreateObject("htmlfile")
html.body.innerhtml = xmlHttp.ResponseText
v_string = html.body.innerhtml
x = InStr(1, v_string, "<LAT>")
If x <> 0 Then
y = InStr(x + 5, v_string, "</LAT>")
GETLAT = Mid(v_string, x + 5, y - (x + 5))
End If
End Function
Function GETLNG(v_address As String, v_suburb As String, v_state As String, v_postcode As Long)
Dim URl As String, lastRow As Long
Dim xmlHttp As Object, html As Object, objResultDiv As Object, objH3 As Object, link As Object
URl = "https://maps.googleapis.com/maps/api/geocode/xml?address=" & Application.WorksheetFunction.Substitute(v_address, " ", "+") & Application.WorksheetFunction.Substitute(v_suburb, " ", "+") & Application.WorksheetFunction.Substitute(v_state, " ", "+") & Application.WorksheetFunction.Substitute(v_postcode, " ", "+") & ",Australia"
Set xmlHttp = CreateObject("MSXML2.XMLHTTP")
xmlHttp.Open "GET", URl, False
xmlHttp.setRequestHeader "Content-Type", "text/xml"
xmlHttp.send
Set html = CreateObject("htmlfile")
html.body.innerhtml = xmlHttp.ResponseText
v_string = html.body.innerhtml
x = InStr(1, v_string, "<LNG>")
If x <> 0 Then
y = InStr(x + 5, v_string, "</LNG>")
GETLNG = Mid(v_string, x + 5, y - (x + 5))
End If
End Function
Sub FindThis()
For r = 2 To 5
Range("F" & r).Value = GETLAT(Range("A" & r).Value, Range("B" & r).Value, Range("C" & r).Value, Range("D" & r).Value)
Range("G" & r).Value = GETLNG(Range("A" & r).Value, Range("B" & r).Value, Range("C" & r).Value, Range("D" & r).Value)
Next r
End Sub
Skriptdən istifadə edərək düzgün nəticələr əldə etmirsinizsə, ehtimal olunan səbəb zədələnmiş excel ola bilər. Bundan sonra istifadə edə bilərsiniz Excel fayl bərpa aləti kimi DataNumen Excel Repair Excel düzəltmək üçün.
Müəllif Giriş:
Nik Vipond məlumatların bərpası üzrə mütəxəssisdir DataNumendaxil olmaqla məlumatların bərpası texnologiyaları üzrə dünya lideri olan , Inc təmir sənəd problemi və Outlook bərpa proqram məhsulları. Ətraflı məlumat üçün ziyarət edin www.datanumen.com