经纬度转换器在线转换(手把手教你经纬度的转换)

我们可以不要懂VBA,但要会懂得用VBA!每个人都可以创建一个属于自己的【E帮办公】。

2cae637d-e7c3-463c-913b-ac9a31433238

情景

随着工作的数字化、地理信息化,最近在工作中遇到很多经纬度采取的事。现场采集回来的经纬度格式五花八门,不能直接满足使用要求,需进一步转换。主要就是十进制表示和度分秒表示之间的转换,还有度、分、秒符号的问题,有些不是英文标的需要转成英文标。为此设计一个经纬度转换的小程序,添加到【E帮办公】中,方便使用。不用再打开浏览器搜索在线经纬度转换;也不用再用一堆函数,设置一堆中间量来转换了。e225dd8adfa349409b5c449db9ccfee3

在线经纬度转换5d99c1128aa54ccbb6e6850a4cb3538a

自编公式经纬度转换

方案

获取需转换单元格的经纬度,利用split()函数将数据进行切片并组成新数组,判断数组长度以识别经纬度的类型。最后通过经纬度转换公式来生成所需的经纬度格式,同时考虑是否将经纬合并在一起表示,用“,”隔开。


如果你觉得有用,还希望给个【关注】给个【赞】!

如果你想要自己的小功能,点击【关注】,在评价区留下小功能的要求!

有需要,可【关注】后【私信】“经纬度格式转换”获取模块。

创建自己的选项卡及将程序添加到选项卡中,参照文章【VBA小程序的添加——创建自己的选项卡】


附上代码供参考

模块部分

Sub 经纬度格式转换()
    Application.DisplayAlerts = False '//关闭系统提示
    
    latLongConversion.Show
    
    Application.DisplayAlerts = True '//恢复系统提示
End Sub

窗体部门

Private Sub CommandButton1_Click()
On Error Resume Next
Dim LatLonRow, LatLonCol, AcRow, AcCol, llArr As Variant, llList As Variant, inRange As Variant, Lat, Lon

If OptionButton1.Value = True Then

    Set llArr = Application.InputBox(prompt, Title:="请选择需转换经纬度的区域", Type:=8) '获取经纬度数据
    Set inRange = Application.InputBox(prompt, Title:="请选择经纬度插入的起始位置(单个单元格)", Type:=8) '获取经纬度数据

    If inRange Is Nothing Then
        AcRow = ActiveCell.Row '获取当前单元格所在行
        AcCol = ActiveCell.Column '获取当前单元格所在列
    Else
        AcRow = inRange.Row '获取当前单元格所在行
        AcCol = inRange.Column '获取当前单元格所在列
    End If
    
    If llArr Is Nothing Then
        MsgBox "未选取有效数据,程序退出!"
        Exit Sub
    End If

    For i = 1 To llArr.Count
        Lat = ""
        Lon = ""
        ll = llArr(i).Value
        ll = Replace(ll, "°", "#")'对经纬度中的字符进行替换
        ll = Replace(ll, "′", "#")
        ll = Replace(ll, "″", "#")
        ll = Replace(ll, ",", "#")
        ll = Replace(ll, ",", "#")
        ll = Replace(ll, "##", "#")
        ll = Replace(ll, " ", "")
        llList = Split(ll, "#")
        Lat = Round(llList(0) + llList(1) / 60 + llList(2) / 3600, 6)
        Lon = Round(llList(3) + llList(4) / 60 + llList(5) / 3600, 6)
        If UBound(llList) > 3 Then
            If CheckBox1.Value = True Then
                Cells(AcRow + i - 1, AcCol) = Lat & "," & Lon
            Else
                Cells(AcRow + i - 1, AcCol) = Lat
                Cells(AcRow + i - 1, AcCol + 1) = Lon
            End If
        Else
            Cells(AcRow + i - 1, AcCol) = Lat
        End If
    Next i
    'err_1: MsgBox Err.Description & ",程序退出!"
Else
    Set llArr = Application.InputBox(prompt, Title:="请选择需转换经纬度的区域", Type:=8) '获取经纬度数据
    Set inRange = Application.InputBox(prompt, Title:="请选择经纬度插入的起始位置(单个单元格)", Type:=8) '获取经纬度数据

    If inRange Is Nothing Then
        AcRow = ActiveCell.Row '获取当前单元格所在行
        AcCol = ActiveCell.Column '获取当前单元格所在列
    Else
        AcRow = inRange.Row '获取当前单元格所在行
        AcCol = inRange.Column '获取当前单元格所在列
    End If
    
    If llArr Is Nothing Then
        MsgBox "未选取有效数据,程序退出!"
        Exit Sub
    End If

    For i = 1 To llArr.Count
        latD = ""
        latF = ""
        latM = ""
        LonD = ""
        LonF = ""
        LonM = ""
        ll = llArr(i).Value
        ll = Replace(ll, "°", "")
        ll = Replace(ll, ",", "#")
        ll = Replace(ll, ",", "#")
        llList = Split(ll, "#")
        latD = Int(llList(0))
        latF = Int((llList(0) - latD) * 60)
        latM = Round((((llList(0) - latD) * 60) - latF) * 60, 2)
        LonD = Int(llList(1))
        LonF = Int((llList(1) - LonD) * 60)
        LonM = Round((((llList(1) - LonD) * 60) - LonF) * 60, 2)
        Lat = latD & "°" & latF & "°" & latM & "°"
        Lon = LonD & "°" & LonF & "°" & LonM & "°"
        If UBound(llList) = 1 Then
            If CheckBox1.Value = True Then
                If Lat <> "" And Lon <> "" Then
                    Cells(AcRow + i - 1, AcCol) = Lat & "," & Lon
                Else
                    If Lat <> "" Then
                         Cells(AcRow + i - 1, AcCol) = Lat
                    Else
                         Cells(AcRow + i - 1, AcCol) = Lon
                    End If
                End If
            Else
                If Lat <> "" And Lon <> "" Then
                    Cells(AcRow + i - 1, AcCol) = Lat
                    Cells(AcRow + i - 1, AcCol + 1) = Lon
                Else
                    If Lat <> "" Then
                        Cells(AcRow + i - 1, AcCol) = Lat
                    Else
                        Cells(AcRow + i - 1, AcCol + 1) = Lon
                    End If
                End If
            End If
            
        Else
            If llList(0) <> "" Then
                Cells(AcRow + i - 1, AcCol) = Lat
            End If
            
        End If
    Next i
End If


End Sub

Private Sub CommandButton2_Click()
Unload Me
End Sub
来源于互联网,侵权请联系邮箱3484479098@qq.com删除
(0)
全球变橙的头像全球变橙
上一篇 2022年3月25日 上午10:39
下一篇 2022年3月25日

相关推荐

  • 高圆圆老公叫什么名字,赵又廷和她2014年就已结婚

    高圆圆早年的荧幕形象都十分经典,特别是周芷若一角让她成为了众多人心目中的女神,而她虽然已经息影多年,但是她美貌的传说却一直流传,出嫁以后更是让众人都很羡慕她的老公。那么高圆圆老公叫…

    2024年3月12日
  • 牛奶怎么加热最好

    在现代家庭中,牛奶是日常生活中不可或缺的饮品之一。无论是早晨的牛奶麦片,中午的奶茶饮料,还是晚上的热巧克力,都需要经过牛奶的加热。如何正确加热牛奶,保持其美味和营养不受损失,是一个…

    2024年3月20日
  • 欧莱雅护肤品怎么样适合什么年龄

    欧莱雅作为一个大型美容品牌,拥有丰富的护肤产品线,适合不同年龄的人群。以下是欧莱雅护肤品的介绍及适用年龄: 1. Hydra Fresh保湿系列:适合20-30岁的年轻女性,这个系…

    2024年2月20日
  • 火星是行星还是恒星,火星是恒星还是卫星

    火星是行星还是恒星 火星是行星。火星是离太阳第四近的行星,也是太阳系中仅次于水星的第二小的行星,为太阳系里四颗类地行星之一。火星自转轴倾角为25.19度,和地球的相近,因此也有四季…

    2023年12月9日
  • 新风系统的作用与功能

    新风系统是一个有效的室内空气处理设施,其作用是通过过滤、通风和空气净化等几种工作方式,为室内提供干净、新鲜的空气。新风系统应用于住宅、办公室、商业和工业等各种建筑类型,以实现健康、…

    2024年3月3日
  • 电脑怎么改用户名

    电脑怎么改用户名?要改用户名,只需进入电脑的设置、账户和个人资料,即可修改用户名。这很容易实现,只需按照以下步骤操作即可。 点击“开始”菜单,然后选择“设置”。在“设置”窗口中,找…

    2024年1月24日
  • 皖h是哪里的车牌号

    皖H是指安徽省(简称“皖”)的机动车车牌号码编码。安徽省是中国的一个省份,位于中国中部,地处华东区域,东邻江苏、浙江,南接江西,西连湖北,北靠河南。该省总面积13.98万平方公里,…

    2024年1月15日
  • 空气炸锅炸薯条怎么做

    空气炸锅是一种健康的烹饪工具,可以制作出很多美味的食品,其中包括最受欢迎的薯条。下面我将为大家介绍一下如何用空气炸锅炸薯条。 材料: – 中等大小的马铃薯或番薯 &#8…

    2024年3月19日
  • 苹果8p怎么截屏

    苹果8p是一款功能强大的智能手机,其中包括许多有用的特性,如截屏功能,以方便用户在需要时快速捕捉屏幕内容。要截取屏幕,使用以下方法: 1. 点按音量增加键和侧面按钮(或电源键)同时…

    2024年1月5日
  • 大骨头炖多长时间

    大骨头炖的时间通常需要在2-3小时之间,这是因为大骨头内含有大量的胶原蛋白和骨髓,需要足够的时间慢慢渗透出来,才能煮出浓郁的肉汤和骨髓。 炖骨头需要足够的时间,以便让骨头中的营养物…

    2024年1月16日

发表回复

登录后才能评论