Ինչպես ստեղծել աշխարհագրական գործիք Excel VBA-ով հասցեների լայնության և երկայնության կոորդինատներ ստանալու համար

Կիսվել հիմա ՝

Հետևեք այս հոդվածին և ստեղծեք ձեր սեփական աշխարհագրական գործիքը, որով կարող եք ստանալ հասցեի լայնության և երկայնության կոորդինատները: Նման փոխարկիչները սովորաբար օգտագործվում են անշարժ գույքի բրոքերների կողմից:

Download Now

Եթե ​​ցանկանում եք սկսել օգտագործել ծրագիրը որքան հնարավոր է շուտ, ապա կարող եք.

Ներբեռնեք ծրագիրը այժմ

Հակառակ դեպքում, եթե ցանկանում եք ինքնուրույն վարվել, կարող եք կարդալ ստորև բերված բովանդակությունը:

Եկեք պատրաստենք GUI

Ձեզ անհրաժեշտ է միայն մեկ Excel աղյուսակ, և դուք կարող եք այն անվանել ձեր կարիքներին համապատասխան: Այս օրինակում ես օգտագործում եմ աղյուսակի լռելյայն անունը՝ «Շերտ 1»: Հաջորդ քայլը այս աղյուսակին անհրաժեշտ վերնագրեր ավելացնելն է: Լայնության և երկայնության փոխարկիչը ճշգրիտ արդյունք է տալիս փոխանցվող հասցեի համար, եթե մուտքագրումը ներառում է արվարձան, նահանգ, փոստային ինդեքս և երկիր: Ինչպես ցույց է տրված նկարում, պատրաստեք վերնագրերը: Եկեք ավելացնենք լայնությունը և երկայնությունը որպես վերջին երկու սյուներ: Մեզ նաև անհրաժեշտ է կոճակ, որը թույլ կտա օգտատիրոջը կատարել փոխակերպումը: Այսպիսով, եկեք ներդնենք ձև և լցնենք այն գույնով, որպեսզի այն երևա որպես կոճակ:Պատրաստեք GUI

Եկեք այն դարձնենք ֆունկցիոնալ

Այստեղ ներկայացված սցենարը պետք է պատճենվի նոր մոդուլի մեջ: Մի մոռացեք պահել ձեր աշխատանքային գիրքը որպես մակրո միացված աշխատանքային գրքի ֆայլ: «FindThis» ենթակետը պետք է կցվի այն կոճակին, որը մենք նոր ենք ստեղծել:

Եկեք փորձարկենք այն

Ավելացրեք հասցեն համապատասխան սյուներում՝ այլ տեղեկությունների հետ միասին: Սեղմեք կոճակը՝ մակրոն գործարկելու համար, որը կցուցադրի աղյուսակում թվարկված բոլոր հասցեների լայնության և երկարության կոորդինատները: Մակրոն կսկսվի 2-րդ տողից և կշարունակի աշխատել մինչև դատարկ տողի հասնելը:Ավելացնել հասցե և սեղմել կոճակը

Ինչպես է դա աշխատում?

Սցենարով մենք ստեղծել ենք երկու գործառույթ. Մեկը լատ արժեք ստանալու համար, մյուսը՝ երկար արժեք ստանալու համար: Օգտագործելով FOR հանգույց, մենք յուրաքանչյուր հասցե փոխանցում ենք այս գործառույթներին և արդյունքը ցուցադրում էկրանին:

Ձեռագիր

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

Եթե ​​դուք ճիշտ արդյունքներ չեք ստանում՝ օգտագործելով սցենարը, ապա կոռումպացված excel-ը կարող է հավանական պատճառ լինել: Այնուհետև կարող եք օգտագործել Excel ֆայլերի վերականգնման գործիք ինչպես, օրինակ, DataNumen Excel Repair Excel-ը շտկելու համար:

Հեղինակի ներածություն.

Nick Vipond- ը տվյալների վերականգման փորձագետ է DataNumen, Inc., որը տվյալների վերականգման տեխնոլոգիաների համաշխարհային առաջատարն է, այդ թվում վերանորոգել փաստաթուղթը և հեռանկարների վերականգնման ծրագրային արտադրանքները: Լրացուցիչ տեղեկությունների համար այցելեք www.datanumen.com

Կիսվել հիմա ՝

Comments փակվում են: