我们可以不要懂VBA，但要会懂得用VBA！每个人都可以创建一个属于自己的【E帮办公】。
情景
随着工作的数字化、地理信息化，最近在工作中遇到很多经纬度采取的事。现场采集回来的经纬度格式五花八门，不能直接满足使用要求，需进一步转换。主要就是十进制表示和度分秒表示之间的转换，还有度、分、秒符号的问题，有些不是英文标的需要转成英文标。为此设计一个经纬度转换的小程序，添加到【E帮办公】中，方便使用。不用再打开浏览器搜索在线经纬度转换；也不用再用一堆函数，设置一堆中间量来转换了。
在线经纬度转换
自编公式经纬度转换
方案获取需转换单元格的经纬度，利用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
