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

我们可以不要懂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日

相关推荐

  • 四大名著的作者是谁

    四大名著是指《红楼梦》、《西游记》、《水浒传》和《三国演义》,是中国文学传统中的经典之作。这四部作品都是明清两朝的代表性文学作品,它们的作者是: 《红楼梦》的作者是曹雪芹。出生于1…

    2024年1月28日
  • 6英寸蛋糕多大

    一般来说,一块6英寸的蛋糕可以分给2-4个人食用,取决于个人的饮食量和口味偏好。 首先需要了解的是6英寸对应的尺寸约为15.24厘米,也就是说蛋糕的直径只有15.24厘米。相比之下…

    2024年2月4日
  • 荷兰猪认主人吗

    荷兰猪可以认主人,这是因为荷兰猪具有智力和记忆力。与其他动物不同,荷兰猪很快能够识别自己的主人,并对他们产生亲密感。这样的特质使得荷兰猪成为了人们喜欢养的宠物之一。 在大多数情况下…

    2024年1月8日
  • 正史李儒后来去哪了

    李儒原是东汉末年著名的谋士,曾为曹操效力并参与过多次重要的谋划,在历史上留下了不可磨灭的印记。李儒的晚年却饱受波折,后来也离奇地消失了。据史书记载,李儒后来出家为僧,在江南隐居了数…

    2024年1月4日
  • 寿喜锅是什么

    寿喜锅是一种传统的日本火锅料理,通常由肥牛、鸡肉、蔬菜等食材组成,配以调味汤料煮熟后食用。它是日本料理中的一支独秀,备受欢迎,成为团聚聚餐的首选。 寿喜锅的名字源于日语“寿司”。在…

    2024年2月2日
  • 多宝塔碑是谁写的

    《多宝塔碑》是唐代文学家韩愈所写。 韩愈是唐代著名文学家、哲学家和散文家,其文风正直刚烈,尤其擅长古文。他一生的主要工作是整理古籍,撰写散文和论述文学和哲学问题。他的文学成就为唐代…

    2024年1月4日
  • 东北牛筋面是什么做的

    东北牛筋面,是用面粉、牛筋和调料等原料制成的一种美食。这种美食是东北地区的一道传统美食,在当地非常受欢迎。 制作东北牛筋面需要选择好的面粉作为原料。东北地区生产的面粉质量很好,因此…

    2024年1月5日
  • coc是什么认证

    COC,全称为 Chain of Custody(原材料追溯认证),是一种以确保原材料流动性、质量、环保、社会责任、唯一性、以及技术规范等标准为依据的认证体系。其主要目的是确保所购…

    2024年1月24日
  • 玉龙雪山海拔多少米

    玉龙雪山位于中国云南省丽江市,是滇藏高原的著名山脉之一,也是丽江重要的自然风景区之一。它的海拔高度是5,596米,是云南省内最高的山峰之一。玉龙雪山峰峰相连,峰峰之间是深邃的峡谷和…

    2024年1月26日
  • 刘晓庆年龄多大

    刘晓庆的年龄是67岁。 刘晓庆是中国著名的演员和歌手,出生于1950年。至今已经在演艺圈发展了近50年的时间,成为了中国电影界的知名人物。她曾在1980年代参与演出了不少经典电视剧…

    2024年2月2日

发表回复

登录后才能评论