EXcel中带度分秒符号的角度与弧度的互化VBA代码

Public Function PI1()
PI1 = Application.WorksheetFunction.PI()
End Function
Function TN(S) As Double '角度化为弧度
Dim Mi As Double
Dim Du, Fen As Integer
Dim Lenth, i, k As Integer
Dim W1, W2, W3 As Integer
k = 1
W1 = W2 = W3 = 0
If (IsNumeric(S)) Then
TN = S
Else
S = Trim(S)
Lenth = Len(S)
If (Mid(S, 1, 1) = "-") Then
S = Mid(S, 2, Lenth - 1)
k = -1
End If
For i = 1 To Lenth
If (Mid(S, i, 1) = "°") Then
W1 = i
Du = CDbl(Mid(S, 1, W1 - 1))
End If
If (Mid(S, i, 1) = "′" Or Mid(S, i, 1) = "'" Or Mid(S, i, 1) = "’") Then
W2 = i
Fen = CDbl(Mid(S, W1 + 1, W2 - W1 - 1))
End If
If (Mid(S, i, 1) = "″" Or Mid(S, i, 1) = """" Or Mid(S, i, 1) = "”") Then
W3 = i
Mi = CDbl(Mid(S, W2 + 1, W3 - W2 - 1))
End If
Next i
TN = k * (Du * 3600 + Fen * 60 + Mi) * PI1() / 180 / 3600
End If
End Function
Function TT(S, Optional n = 2) As String '弧度化为角度
Dim k As Integer
Dim Du, Fen As Integer
Dim Mi As Double
Dim SDu, SFen, SMi As String
Dim J, Q As Double
k = 1
If (Not IsNumeric(S)) Then
TT = Trim(S)
Else
If (S < 0) Then
k = -1
S = -S
End If
Du = Int(S * 180 / PI1())
Fen = Int(S * 180 * 60 / PI1()) Mod 60
Mi = S * 180 * 3600 / PI1() - Int(S * 180 * 3600 / PI1()) + Int(S * 180 * 3600 / PI1()) Mod 60
Mi = Round(Mi, n)
If (Mi = 60) Then
Mi = 0
Fen = Fen + 1
End If
If (Fen = 60) Then
Fen = 0
Du = Du + 1
End If
J = (Du * 3600 + Fen * 60 + Mi) * PI1() / 180 / 3600
Q = Abs(J - S) * 180 * 3600 / PI1()
If (Q > 59 And Q < 61) Then
If (J > S) Then
Fen = Fen - 1
End If
If (J < S) Then
Fen = Fen + 1
End If
End If
If (Q > 119 And Q < 121) Then
If (J > S) Then
Fen = Fen - 2
End If
If (J < S) Then
Fen = Fen + 2
End If
End If
If (Fen < 0) Then
Fen = Fen + 60
Du = Du - 1
End If
SDu = CStr(Du)
If (Fen < 10) Then
SFen = "0" & CStr(Fen)
Else
SFen = CStr(Fen)
End If
If (Mi < 10) Then
SMi = "0" & CStr(Mi)
Else
SMi = CStr(Mi)
End If
If (k = -1) Then
TT = "-" & SDu & "°" & SFen & "′" & SMi & "″"
Else
TT = SDu & "°" & SFen & "′" & SMi & "″"
End If
End If
End Function
Function sumTT(ParamArray k()) As String '求和
Dim i As Integer
Dim J As Integer
Dim h As Integer
Dim w As Double
w = 0
For i = 0 To UBound(k)
For J = 1 To k(i).Rows.Count
For h = 1 To k(i).Columns.Count
w = w + TN(k(i).Cells(J, h))
Next h
Next J
Next i
sumTT = TT(w)
End Function
Function sumTN(ParamArray k()) As Double
Dim i As Integer
Dim J As Integer
Dim h As Integer
Dim w As Do

uble
w = 0
For i = 0 To UBound(k)
For J = 1 To k(i).Rows.Count
For h = 1 To k(i).Columns.Count
w = w + TN(k(i).Cells(J, h))
Next h
Next J
Next i
sumTN = w
End Function
Function AT(ParamArray k()) As String '求平均
Dim i As Integer
Dim J As Integer
Dim h As Integer
Dim n As Integer
Dim w, v As Double
w = 0
v = 0
For i = 0 To UBound(k)
For J = 1 To k(i).Rows.Count
For h = 1 To k(i).Columns.Count
w = w + TN(k(i).Cells(J, h))
If ((Not IsNumeric(k(i).Cells(J, h))) And (k(i).Cells(J, h) <> "")) Then
v = v + 1
End If
Next h
Next J
Next i
AT = TT(w / v)
End Function