春节在家闲的蛋痛，用Excel VBA 实现梅登黑德坐标转换功能，在VBE中输入以下代码，Excel 就增加了两个梅登黑德坐标转换函数。
嫌麻烦的可直接下载附件，在相应的单元格中输入就可以了。
Public Function LatitudeAndLongitudeToMadenheadGrid(Longitude As String, Latitude As String) As String
' 经纬度 转 梅登黑德网格
' Longitude: 经度，东为正，西为负。 度、分、秒用“,” 分隔。
' Latitude:纬度，北为正，南为负。度、分、秒用“,” 分隔。
' bh4bin
' 2023/1/29
Dim A As Single, B As Single, C As Single
Dim D As Single, E As Single, F As Single
Dim X As Single, Y As Single
Dim grid As String, Tmp As String
Dim InputAyy() As String
If Trim(Longitude) = "" Or Trim(Latitude) = "" Then Exit Function
InputAyy = Split(Trim(Longitude), ",")
A = InputAyy(LBound(InputAyy))
B = InputAyy(LBound(InputAyy) + 1)
C = InputAyy(UBound(InputAyy))
X = A + B / 60 + C / 3600 + 1 / 1000000
InputAyy = Split(Trim(Latitude), ",")
D = InputAyy(LBound(InputAyy))
E = InputAyy(LBound(InputAyy) + 1)
F = InputAyy(UBound(InputAyy))
Y = D + E / 60 + F / 3600 + 1 / 1000000
If X >= -180 And X < 180 And Y >= -90 And Y <= 90 Then
A = X / 20 + 9: B = Int(A): grid = Chr$(B + 65)
C = Y / 10 + 9: D = Int(C): grid = grid + Chr$(D + 65)
A = (A - B) * 10: B = Int(A): grid = grid + Chr$(B + 48)
C = (C - D) * 10: D = Int(C): grid = grid + Chr$(D + 48)
B = Int((A - B) * 24): grid = grid + Chr$(B + 97)
D = Int((C - D) * 24): grid = grid + Chr$(D + 97)
LatitudeAndLongitudeToMadenheadGrid = grid
Else
Tmp = MsgBox(prompt:="数据有误，请检查!!!", Buttons:=vbExclamation, Title:="警告")
Exit Function
End If
End Function
Public Function GridToLatitude(Optional grid As String = "PM01qd ") As String
' 梅登黑德网格 转 经纬度
' Longitude: 经度，东为正，西为负。
' Latitude:纬度，北为正，南为负。
' bh4bin
' 2023/1/29
Dim strArr(1 To 6) As String
Dim Longitude As Double, Latitude As Double
Dim LongGroup As String, LatGroup As String
grid = UCase(grid)
For i = 1 To 6
strArr(i) = Mid(Trim(grid), i, 1)
Next i
Longitude = (Asc(strArr(1)) - 65 - 9) * 20 + Val(strArr(3)) * 2 + (Asc(strArr(5)) - 65) * 5 / 60
Latitude = (Asc(strArr(2)) - 65 - 9) * 10 + Val(strArr(4)) * 1 + Round((Asc(strArr(6)) - 65) * 2.5 / 60, 5)
If (Asc(strArr(1)) - 65 - 9) * 20 > 0 Then
LongGroup = "东经"
Else
LongGroup = "西经"
End If
If (Asc(strArr(2)) - 65 - 9) * 20 > 0 Then
LatGroup = "北纬"
Else
LatGroup = "南纬"
End If
GridToLatitude = "经度在: " & LongGroup & Round(Longitude, 5) & " ~ " & Round(Longitude + 5 / 60, 5) & "; 纬度在: " & LatGroup & Round(Latitude, 5) & " ~ " & Round(Latitude + 2.5 / 60, 5)
End Function
Sub test()
Dim Latitude As String
Dim Longitude As String
Longitude = InputBox(prompt:="东经+，西经-。度、分、秒用【,】分隔！", Title:="请输入经度", Default:="111,11,22")
Latitude = InputBox(prompt:="北纬+，南纬-。度、分、秒用【,】分隔！", Title:="请输入纬度", Default:="11,1,21")
If Longitude = "" Or Latitude = "" Then Exit Sub
MsgBox prompt:=LatitudeAndLongitudeToMadenheadGrid(Longitude, Latitude), Title:="您的梅登黑德网格(Madenhead grid):"
End Sub
