实用VBA：18.角度或坐标的格式转换（单位换算）

1.需求场景

在某些行业工作中，可能会遇到需要将角度或者坐标数值进行格式转换或者单位换算的情形。有很多小工具可以实现这样的换算，也有一些大型的专业软件带有单位换算的模块或者小插件，或者在excel单元格中写入计算公式。其实使用VBA写个函数也可以很方便地进行转换，在用Excel进行数据处理时就不用再打开其他软件进行换算了。例如，已知了度分秒格式的数据，需要转换为十进制°值的格式。

2.解决思路

十进制的度值（°）与度分秒（°  ′  ″）之间的转换关系很简单，度值是一个十进制的浮点数，度分秒是一个60进制的数值表示方式。1°=60′=3600″，我们手工或利用计算器计算或者使用excel公式也是使用的这个简单的关系。

因此，就可以用VBA写一个简单的函数，进行不同格式的转换（单位换算）：

度值（°）转换为度分秒（°  ′  ″） 定义为函数DDtoDMS()

度分秒（°  ′  ″）转换为度值（°） 定义为函数DMStoDD

度分秒（°  ′  ″）转换为秒值（″） 定义为函数DMStoSS()

秒值（″）转换为度分秒（°  ′  ″） 定义为函数SStoDMS()

……

函数写好之后在excle数据的单元格中调用自定义的函数即可。

例如上图，定义好一个格式化的模板，将“输入值”右侧的空白单元格当做输入框，随时输入需要转换的数值，在“输出值”右侧输入好自定义的函数，于是便可实现输出值实时根据输入值显示转换结果的效果。一个自定义出来的格式转换器就完成了。有大量数据需要转换时，在目标单元格中输入自定义函数即可。

3.VBA实现

'度分秒转换为秒

Function DMStoSS(du As Double) As Double

    Dim dd, ff, mm As Double

    '度位数值换算为秒

    dd = Int(du / 10000) * 3600

    '分位数值换算为秒

    ff = Int((du - Int(du / 10000) * 10000) / 100) * 60

    '秒位数值换算为秒

    mm = du - Int(du / 100) * 100

    '各数位秒值相加作为返回值

    DMStoSS = dd + ff + mm

End Function


'秒转为度分秒

Function SStoDMS(DBss As Double) As String

    Dim dd, mm As Integer

    Dim ss As Double

    '求度位整数值

    dd = Int(DBss / 3600)

    '求分位整数值

    mm = Int((DBss - dd * 3600) / 60)

    '求秒位小数值

    ss = DBss - dd * 3600 - mm * 60

    '返回值，拼接度分秒格式字符串

    SStoDMS = dd & "°" & Format(mm, "00") & "′" & Format(ss, "00.00000") & "″"

End Function


'度转换为度分秒

Function DDtoDMS(DBdd As Double) As String

    Dim dd, mm As Integer

    Dim ss As Double

    '取度值整数位

    dd = Int(DBdd)

    '计算分位

    mm = Int((DBdd - dd) * 60)

    '计算秒位

    ss = (DBdd - dd - mm / 60) * 3600

    

    '返回值,拼接度分秒格式字符串

    DDtoDMS = dd & "°" & Format(mm, "00") & "′" & Format(ss, "00.00000") & "″"

End Function


'度分秒转换为度值

Function DMStoDD(dms As Double) As Double

    Dim dd, mm As Integer

    Dim ss As Double

    '获取度位整数值

    dd = Int(dms / 10000)

    '获取分位整数值

    mm = Int((dms - dd * 10000) / 100)

    '获取秒位数值

    ss = dms - dd * 10000 - mm * 100

    '返回值,计算度值

    DMStoDD = Format(dd + mm / 60 + ss / 3600, "0.00000000")

End Function

4.运行效果

当小工具使用的效果：

批量转换的效果：

喜欢的话欢迎关注、点赞、转发或评论交流！

点赞富三代，分享美一生！ ^|^

5.往期列表

实用VBA：1.向下填充空白单元格

实用VBA：2.隔行插入空白行

实用VBA：3.向下合并空白单元格

实用VBA：4.按列拆分工作表

实用VBA：5.批量汇总工作簿、合并工作表

实用VBA：6.一键批量提取文件名和存储路径 

实用VBA：7.按文件列表一键汇总excel工作簿 

实用VBA：8.一键输出多表格为单独文件

实用VBA：9.使用Excel批量套模板，一键输出多个工作表

实用VBA：10.用VBA向Excel文件中自动插入图片 

实用VBA：11.用Excel自动生成商品调拨单

实用VBA：12.用VBA将txt文本文件导入Excel表格 

实用VBA：13.Excel数据批量套模板输出pdf文件

实用VBA：14.在二维数组中查找特定元素 

实用VBA：15 一键批量汇总工作表的更优方法 

实用VBA：16.一键批量删除工作表

实用VBA：17.大量word文件中的文本内容进行批量替换 

（佛系更新中……）