２辺と１夾角で１辺の距離を求めるユーザー関数を
作ってみました。境界点間測量などでご利用ください。

計算式 a=√（b^2+c^2-2×ｂ×ｃ×cos A)

※　計算途中にはこのブログ内で公開しているユーザー関数を使用しています。
必要に応じて確認お願いします。

ご利用は動作等をご確認の上、自己責任でお願いします。


Public Function 二辺夾角1(観測角A As String, 水平距離A As String, 観測角B As String, 水平距離B As String, 縮尺係数 As String) As Double
'二辺夾角（余弦定理）AB点間の辺長を計算します。

    If CDbl(deg(観測角A)) < CDbl(deg(観測角B)) Then
   
        二辺夾角1 = Format(Sqr((CDbl(水平距離A) ^ 2 + CDbl(水平距離B) ^ 2) - (2 * CDbl(水平距離A) * CDbl(水平距離B) * _
        Cos(Rad10(deg(観測角B) - deg(観測角A))))) * CDbl(縮尺係数), "0.000")
   
    Else
   
        二辺夾角1 = Format(Sqr((CDbl(水平距離A) ^ 2 + CDbl(水平距離B) ^ 2) - (2 * CDbl(水平距離A) * CDbl(水平距離B) * _
        Cos(Rad10(deg(観測角A) - deg(観測角B))))) * CDbl(縮尺係数), "0.000")
   
    End If

End Function

久しぶりに書き込みました。
基準点の測量」データをお客より借用した時、
成果表数値フォーマットで座標値を抽出するのが面倒だったので
作ってみました。ただし、視準点データは必要なかったので表示しません。

ご利用は動作等をご確認の上、自己責任でお願いします。

'**********************************************
'基準点測量
'成果表数値フォーマットを1行にして取り込みます。
'**********************************************
Sub 成果簿読み込み()

Dim FileNumber As Integer
Dim obj As Object
Dim aFile As Variant
Dim FiStr As String
Dim str() As String
Dim tstr As String
Dim m() As String
Dim i As Integer
   
    i = 4

On Error GoTo 終了

Set obj = ActiveSheet    'オブジェクトの参照

      Cells.Activate
      Cells.Delete                           'セルの削除

    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With
   
    ActiveSheet.Select
    Application.ScreenUpdating = True     '作業中画面の表示

    aFile = Application.GetOpenFilename _
            (FileFilter:="カンマ切ファイル, *.csv; *.txt,すべてのファイル (*.*),*.*", MultiSelect:=False)

        If aFile = False Then       'キャンセルの処理
       
            Exit Sub
        End If

    FileNumber = FreeFile  '空いている番号を取得

    Open aFile For Input As #FileNumber  'ファイルオープン

    Do While Not EOF(1)             'ファイル読込
   
        Line Input #FileNumber, FiStr      '１行読み込む
   
            str = Split(FiStr, ",")      'カンマ区切りで配列に格納

'************  成果の情報  ************
        Select Case str(0)
           
            Case "Z00"
           
            Case "Z01"
                Range(Cells(1, 1), Cells(1, 1)) = str(1)
       
            Case "Z02"
           
                Select Case str(1)
               
                    Case "0"
                         Range(Cells(2, 1), Cells(2, 1)) = "世界測地系"
                    Case "1"
                         Range(Cells(2, 1), Cells(2, 1)) = "日本測地系"
                    Case Else
                End Select
             Case "A00"
             Case "A99"
'************　測点データ1  ************
   
            Case "A01" 'A01,点番号,点名称,緯度,経度,Ｘ座標,Ｙ座標,座標系,標高,ジオイド高
'点番号
                Range(Cells(i, 1), Cells(i, 1)).NumberFormatLocal = "0_ "
                Range(Cells(i, 1), Cells(i, 1)) = str(1)
'点名称
                Range(Cells(i, 2), Cells(i, 2)).NumberFormatLocal = "@"
                Range(Cells(i, 2), Cells(i, 2)) = str(2)
'緯度
                Range(Cells(i, 3), Cells(i, 3)).NumberFormatLocal = "@"
                Range(Cells(i, 3), Cells(i, 3)) = Format(str(3), "0.00000000")
'経度
                Range(Cells(i, 4), Cells(i, 4)).NumberFormatLocal = "@"
                Range(Cells(i, 4), Cells(i, 4)) = Format(str(4), "0.00000000")

'Ｘ座標 32768.598で表示が32768.5979999999となる為、文字表示にした。
                Range(Cells(i, 5), Cells(i, 5)).NumberFormatLocal = "@ "
                Range(Cells(i, 5), Cells(i, 5)) = Format(str(5), "0.000")
'Ｙ座標
                Range(Cells(i, 6), Cells(i, 6)).NumberFormatLocal = "@ "
                Range(Cells(i, 6), Cells(i, 6)) = Format(str(6), "0.000")
'座標系
                Range(Cells(i, 7), Cells(i, 7)).NumberFormatLocal = "@"
                Range(Cells(i, 7), Cells(i, 7)) = str(7)
'標高
                Range(Cells(i, 8), Cells(i, 8)).NumberFormatLocal = "@ "
                Range(Cells(i, 8), Cells(i, 8)) = Format(str(8), "0.000")
'ジオイド高
                Range(Cells(i, 9), Cells(i, 9)).NumberFormatLocal = "@ "
                Range(Cells(i, 9), Cells(i, 9)) = Format(str(9), "0.000")
          
                i = i + 1    '1行+
       
'************　測点データ2　************
   
            Case "A02"  'A02,等級,縮尺係数,真北方向角,柱石長,埋表形式,標識,標識番号
                        '※柱石長、埋表形式、標識、標識番号は入れていない
                b = str(0)
                i = i - 1
 '等級
                Select Case str(1)
                    Case "10"
                        Cells(i, 10).Value = "電子基準点"
                    Case "11"
                        Cells(i, 10).Value = "1等三角点"
                    Case "12"
                        Cells(i, 10).Value = "2等三角点"
                    Case "13"
                        Cells(i, 10).Value = "3等三角点"
                    Case "14"
                        Cells(i, 10).Value = "4等三角点"
                    Case "21"
                        Cells(i, 10).Value = "1級基準点"
                    Case "22"
                        Cells(i, 10).Value = "2級基準点"
                    Case "23"
                        Cells(i, 10).Value = "3級基準点"
                    Case "24"
                        Cells(i, 10).Value = "4級基準点"
                    Case Else
                End Select
'縮尺係数
                Range(Cells(i, 11), Cells(i, 11)).NumberFormatLocal = "@"
                Range(Cells(i, 11), Cells(i, 11)) = Format(str(2), "0.000000")
'真北方向角
                Range(Cells(i, 12), Cells(i, 12)).NumberFormatLocal = "@"
                Range(Cells(i, 12), Cells(i, 12)) = Format(str(3), "0.00000")
       
                i = i + 1
            Case "A03"  'A03,方向数
            Case "A04"  'A04,点番号,点名称,等級,平均方向角,距離,備考
            Case Else
           
                MsgBox ("成果数値データファイルではありません。")
               
                Range("A1").Select
                Cells.Delete                           'セルの削除
               
                End
   
            End Select

Loop
   
'************　タイトル　************
   
        Cells(3, 1).Value = "点番"
        Cells(3, 2).Value = "点名"
        Cells(3, 3).Value = "緯度"
        Cells(3, 4).Value = "経度"
        Cells(3, 5).Value = "Ｘ座標"
        Cells(3, 6).Value = "Ｙ座標"
        Cells(3, 7).Value = "座標系"
        Cells(3, 8).Value = "標高"
        Cells(3, 9).Value = "ジオイド高"
       
        If b = "A02" Then
           Cells(3, 10).Value = "等級"
           Cells(3, 11).Value = "縮尺係数"
           Cells(3, 12).Value = "真北方向角"
        End If
'列幅設定
    tstr = "5.7,14,14,14,13,13,5.7,10.7,10.7,10.7,10.7,10.7"
    m = Split(tstr, ",")
   
    For i = 0 To UBound(m)
             obj.Columns(i + 1).ColumnWidth = m(i)
  
    Next
   
    Close #FileNumber  'ファイルクローズ

        Range("A1:A2").Select
        With Selection
            .HorizontalAlignment = xlLeft
            .VerticalAlignment = xlCenter
        End With

    Set obj = Nothing  'オブジェクトの参照解除
       
        Erase str
        Exit Sub
       
終了:
    MsgBox ("完了できませんでした。")

    Range("A1").Select
    Cells.Delete                           'セルの削除
    End

End Sub

 既知の2点間の距離をvlookupを使用して計算するユーザー関数を作って見ました。

Public Function 点間距離(X1 As Double, Y1 As Double, X2 As Double, Y2 As Double) As Double
'2点間の距離の算出（座標値の場合）
Dim dx As Double
Dim dy As Double

dx = X2 - X1
dy = Y2 - Y1

点間距離 = Format(Sqr(dx ^ 2 + dy ^ 2), "0.000")
点間距離= CDbl(点間距離)

End Function

Public Function 点間距離V(器械 As String, 後視 As String, 座標範囲 As Range) As Double
'（点名を座標リストより検索、抽出）座標範囲は1範囲
Dim 器械X As Double
Dim 器械Y As Double
Dim 後視X As Double
Dim 後視Y As Double

器械X = Application.WorksheetFunction.VLookup(器械, 座標範囲, 2, False)
器械Y = Application.WorksheetFunction.VLookup(器械, 座標範囲, 3, False)
後視X = Application.WorksheetFunction.VLookup(後視, 座標範囲, 2, False)
後視Y = Application.WorksheetFunction.VLookup(後視, 座標範囲, 3, False)
    
点間距離V = 点間距離(器械X, 器械Y, 後視X, 後視Y)
   
End Function

ご利用は動作等をご確認の上、自己責任でお願いします。

 角度の合計を行うとき、度単位になおして合計して
また度分秒に変換を行ってました。
出来ればsum関数のようにできないかとやってみました。
結果は、度.分秒で表示されますので、
角度の合計後、割り算等する場合は、
最後のdmsをなくして度単位の表示で使用してください。

このユーザー関数は、セル(セル範囲）を選択して使用します。

例　=角合計60(A1,A2,B7:B10)　

Public Function 角合計60(ParamArray セル()) As String
  Dim a As String       'セルの値
  Dim b As Variant      'セル、セル範囲
  Dim c As Range   'セル単位
  Dim goukei As String
   
    goukei = 0
   
    For Each b In セル                      '値を分割してbに格納このときbにまだセル範囲の場合がある？なのでもう１回
        For Each c In b                'bをセル単位でcに格納
            a = c.Value                'セルの値をaに取得
            If a = "" Then
            a = "0"
            goukei = deg(a) + CDbl(goukei)
            Else
            goukei = deg(a) + CDbl(goukei)
            End If
        Next
    Next

角合計60 = dms(goukei)
   
End Function

※　計算途中にはこのブログ内で公開しているユーザー関数を使用しています。
必要に応じて確認お願いします。

ご利用は動作等をご確認の上、自己責任でお願いします。

今日は球面距離の計算をexcel ワークシート上で計算出来るように、
ユーザー関数にしました。
前回の縮尺係数の計算で算出した値（２点間の縮尺係数平均）をこの球面距離にかけると
平面距離になります。
関数を使用の際、視準点標高・平均ジオイド高など、ない場合は ""　と入力して下さい。
空白では、エラーになります。

※　計算途中にはこのブログ内で公開しているユーザー関数を使用しています。
必要に応じて確認お願いします。

ご利用は動作等をご確認の上、自己責任でお願いします。


'-----------------------------------------------------------------------
'球面距離の計算
'平均標高を使用する場合は、
'器械hと視準hに平均標高を入力し、ihとfhに 0.000を入力してください。
'-----------------------------------------------------------------------
Public Function 球面距離(斜距離 As String, 器械h As String, 正α As String, 視準h As String, 反α As String, ih As String, fh As String, ジオイド高 As String) As String

'斜距離:    斜距離
'器械h:     器械点標高 （標高がない場合は、""と入力）
'正α:      器械点からの高度角
'視準h:     視準点標高  （標高がない場合は、""と入力）
'反α:      視準点からの高度角
'ih:        器械高  （入力しない場合は、""と入力）
'fh:        目標高  （入力しない場合は、""と入力）
'ジオイド高:平均ジオイド高  （入力しない場合は、""と入力）

Dim 平均α As String
Dim 平均標高 As Double

Const R = 6370000   '平均曲率半径（m）

On Error Resume Next

If ih = "" Then '器械高が""のとき
    ih = 0
End If
If fh = "" Then '目標高が""のとき
    fh = 0
End If
If ジオイド高 = "" Then '平均ジオイド高が""のとき
    ジオイド高 = "0.000"
End If

If 反α <> "" Then
    平均α = dms((deg(正α) - deg(反α)) / 2)
Else
    平均α = 正α
End If

If 器械h = "" And 視準h = "" Then   '標高が""のとき
        器械h = 0
        視準h = Format((Sin(Rad60(平均α)) * CDbl(斜距離)) + CDbl(ih) - CDbl(fh) + CDbl(器械h), "0.000") '視準点標高の概算計算
       
ElseIf 器械h <> "" And 視準h = "" Then   '視準標高が""のとき
        視準h = Format((Sin(Rad60(平均α)) * CDbl(斜距離)) + CDbl(ih) - CDbl(fh) + CDbl(器械h), "0.000") '視準点標高の概算計算

ElseIf 器械h = "" And 視準h <> "" Then '器械標高が""のとき
        器械h = Format((Sin(Rad60(平均α) * -1) * CDbl(斜距離)) + CDbl(fh) - CDbl(ih) + CDbl(視準h), "0.000") '器械点標高の概算計算

End If

平均標高 = Format((CDbl(器械h) + CDbl(ih) + CDbl(視準h) + CDbl(fh)) / 2, "0.000")
   
球面距離 = Format(CDbl(斜距離) * Cos(Rad60(平均α)) * (R / (R + 平均標高 + CDbl(ジオイド高))), "0.000")
   
End Function

 もう５月も終わろうとしています。でも会社はひまひまひまです。
明日は何をしようかなぁ？
新しい作業規程の準則でも読もうかなぁ。
とりあえず、成果表に記載する縮尺係数のユーザー関数を
作ったので掲載します。
式は、作業規定の準則　計算式集
2.8.3 成果表に記載する縮尺係数　です。

ご利用は動作等をご確認の上、自己責任でお願いします。


Public Function 縮尺係数(y As Double) As String
'y：当該点のy 座標

Const R0 = 6370000  '平面直角座標系原点の平均曲率半径
Const M0 = 0.9999   '平面直角座標系原点の縮尺係数

縮尺係数 = Format(M0 * (1 + (3 * y ^ 2) / (6 * R0 ^ 2 * M0 ^ 2)), "0.000000")

End Function

すみません。
また不備がありました。
 0°01′00″表示の場合、正しく計算できていませんでした。
5/17分を削除致します。

Excelで三角関数（sin,cos,tan)を利用する場合、角度（度分秒）を
ラジアンに変換しなければいけません。
たとえば　60度30分36秒の場合、1度＝60分、1度＝3600秒ですので
30分＝30÷60＝0.5度
36秒＝36÷3600＝0.01度
60+0.5+0.01＝60.51度　になり、
ラジアンに変換すると
 パイ=3.14159265358979
360(度)＝2パイ(ラジアン)
180(度)＝1パイ(ラジアン)
 90(度)＝1/2パイ(ラジアン)

　　　　　　　   パイ
60.51(度)　×────　＝　1.05609873038177　(ラジアン)　になります。
　　　　　　　   180

これでやっと三角関数が利用できます。
これをふまえて、三角関数で角度を算出した場合、ラジアン単位で算出されます。

この計算を簡単にする為、ユーザー関数を作って見ました。
ユーザー関数
deg　　　    度分秒を度に変換(3種類の表示に対応）
Rad60　　　度分秒をラジアン
Rad10    　度をラジアン（RADIANS関数と同じです）
Raddeg    ラジアンを度（DEGREESと同じです)
Raddms    ラジアンを度分秒

ご利用は動作等をご確認の上、自己責任でお願いします。

修正箇所赤表示

'----------------------------------------------------------------------

'度分秒を度に変換(3種類の表示に対応）
'60.3036     --＞60.51
'60-30-36    --＞60.51
'60°30′36″--＞60.51

'----------------------------------------------------------------------
Public Function deg(ang As String) As Double
'度分秒を度
Dim mydo As Double
Dim myhun As Double
Dim mybyou As Double
Dim mybyou2 As Double
Dim i As Integer
Dim a As Integer
Dim b As Integer
Dim c As Integer
Dim d As Double
Dim mya As Integer
Dim myb As Integer
Dim myc As Integer
Dim myang() As String
Dim ang2 As Double
   

    mya = InStr(ang, ".")           '0.0000表示
    myb = InStr(2, ang, "-")        '0-00-00表示
    myc = InStr(ang, "°")          '0°00′00″表示

    If mya > 0 And mya < 5 Then     '0.0000表示
        d = CDbl(ang)       '符号判定用
        If ang = 0 Then
            deg = 0
            GoTo 終了
        Else
            ang = Format(ang, "0.00000#")
            i = InStr(ang, ".")
            mydo = Int(Abs(ang))
            myhun = Mid(ang, i + 1, 2)
            mybyou = Mid(ang, i + 3, 2)
        End If
   
    ElseIf myb > 1 Then             '0-00-00表示
        a = InStr(1, ang, "-", vbTextCompare) '符号判定
        If a > 1 Then
            myang = Split(ang, "-")
            mydo = myang(0)
            myhun = myang(1)
            mybyou = myang(2)
           
            d = 1  '符号判定用
        Else
            myang = Split(ang, "-")
            mydo = myang(1)
            myhun = myang(2)
            mybyou = myang(3)
           
            d = -1  '符号判定用
        End If
   
    ElseIf myc > 0 Then             '0°00′00″表示
        a = InStr(ang, "°")
        b = InStr(ang, "′")
        c = InStr(ang, "″")
        d = InStr(ang, "-") '符号
       
        mydo = Mid(ang, 1, a - 1)
        myhun = Mid(ang, a + 1, b - a - 1)
        mybyou = Mid(ang, b + 1, c - b - 1)
       
    Select Case d '符号判定用
        Case "0"
        d = 0
        Case "1"
        d = -1
    End Select
    Else                            '0とブランクの時
        deg = 0
        GoTo 終了
    End If
        deg = mydo + (myhun / 60) + (mybyou / 3600)
          
           '符号判定
If d >= 0 Then
    deg = deg
Else
    deg = -deg
End If
終了:
End Function

'----------------------------------------------------------------------
'度分秒をラジアン
'ワークシート関数を使用するとき表示が長いのでVBA内での使用用
'----------------------------------------------------------------------
Public Function Rad60(ang As String) As Double

Rad60 = Application.WorksheetFunction.Radians(deg(ang))

End Function

'----------------------------------------------------------------------
'度をラジアン　
'ワークシート関数を使用するとき表示が長いのでVBA内での使用用
'----------------------------------------------------------------------
Public Function Rad10(ang As String) As Double

Rad10 = Application.WorksheetFunction.Radians(ang)

End Function

'----------------------------------------------------------------------
'ラジアンを度
'----------------------------------------------------------------------
Public Function Raddeg(rad As Double) As String

Raddeg = Application.WorksheetFunction.Degrees(rad)

End Function

'----------------------------------------------------------------------
'ラジアンを度分秒（*.******)
'----------------------------------------------------------------------
Public Function Raddms(rad As Double) As String

Dim mydo As String

mydo = Application.WorksheetFunction.Degrees(rad)

Raddms = dms(mydo)

End Function

5/17 ユーザー関数　degで訂正がありました。
間違い部分は、取り消し線を入れていますので
ご利用の方は確認お願いします。

今日は、鉛直角の計算を作って見ました。
望遠鏡（正）（反）の平均を計算する時、ちょっとした計算ですが
面倒なので作りました。

ご利用は動作等をご確認の上、自己責任でお願いします。
'----------------------------------------------------------------------

Public Function 定数(正 As String, 反 As String) As String
'角度の足し算【鉛直角正、反用】

定数 = dms(deg(正) + deg(反))
End Function

'----------------------------------------------------------------------

Public Function vang(正 As String, 反 As String) As String
'鉛直角の正と反の平均
Dim z2 As String

z2 = (360 + deg(正) - deg(反))
vang = dms(z2 / 2)
End Function

'----------------------------------------------------------------------

Public Function 高度角(鉛直 As String) As String
'鉛直角(天頂0)を高度角(水平0)にする。

高度角 = dms(90 - deg(鉛直))
End Function

 今日こそラジアンを度分秒表示を作ろうと思っていましたが、
昨日作った度を度分秒でほぼ完成していました。
と、いうのも、ラジアンをDEGREES関数を使用すると、
度表示になるので、昨日のユーザー関数dmsで度分秒に変換できます。

たとえば
deg(60°30′36″)=60.51
RADIANS(60.51)=1.05609873038177
DEGREES(1.05609873038177)=60.51
dms(60.51)=60.3036
になります。

ですので次に度分秒にしたとき
60.3036
60-30-36
60°30′36″の3種類の表示に変換する関数を作ってみました。

ご利用は動作等をご確認の上、自己責任でお願いします。

'----------------------------------------------------------------------
'度分秒の表示を変更する。【表示1:0.0000 2:0-00-00 3:0°00′00″】
'hen("60°30′36″",1)=60.3036
'hen("60.3036",2)=60-30-36
'hen("60-30-36",3)=60°30′36″
'----------------------------------------------------------------------
Public Function hen(ang As String, 表示 As String) As String
Dim mydo As String
Dim myhun As String
Dim mybyou As String
Dim myang() As String
Dim ang2 As Double
Dim mya As Integer
Dim myb As Integer
Dim myc As Integer
Dim i As Integer
Dim a As Integer
Dim b As Integer
Dim c As Integer

    ang2 = 0                    'ブランクは0になる
    mya = InStr(ang, ".")       '表示0.0000の判定
    myb = InStr(2, ang, "-")    '表示0-00-00の判定
    myc = InStr(ang, "°")      '表示0°00′00″の判定
   
    If mya > 0 Then             '0.0000表示
        ang2 = CDbl(ang)
            If ang = 0 Then
                mydo = "0"
                myhun = "00"
                mybyou = "00"
            Else
                ang = Format(ang, "0.00000#")
                i = InStr(ang, ".")
                mydo = Int(Abs(ang))
                myhun = Mid(ang, i + 1, 2)
                mybyou = Mid(ang, i + 3, 2)
            End If
   
    ElseIf myb > 1 Then         '0-00-00表示
   
        i = InStr(1, ang, "-", vbTextCompare)   'マイナス角度の判定（頭に-符号が付いていたらi=1)
        Select Case i
            Case "1"
                myang = Split(ang, "-")
                mydo = Format(myang(1), "0")
                myhun = Format(myang(2), "00")
                mybyou = Format(myang(3), "00")
                ang2 = CDbl("-" & mydo & "." & myhun & mybyou)
            Case Else
                myang = Split(ang, "-")
                mydo = myang(0)
                myhun = Format(myang(1), "00")
                mybyou = Format(myang(2), "00")
                ang2 = CDbl(mydo & "." & myhun & mybyou)
        End Select
   
    ElseIf myc > 0 Then         '0°00′00″表示
       
        a = InStr(ang, "°")
        b = InStr(ang, "′")
        c = InStr(ang, "″")
           
        mydo = Mid(ang, 1, a - 1)
        myhun = Format(Mid(ang, a + 1, b - a - 1), "00")
        mybyou = Format(Mid(ang, b + 1, c - b - 1), "00")
       
     ang2 = CDbl(mydo & "." & myhun & mybyou)
        mydo = Abs(mydo)
    Else                        '0とブランクの時
        mydo = "0"
        myhun = "00"
        mybyou = "00"
    End If
   
    Select Case 表示
        Case "1"
        hen = mydo & "." & myhun & mybyou
            If ang2 > 0 Then
            hen = Format(hen, "0.0000")
            Else
            hen = Format(-hen, "0.0000")
            End If
        Case "2"
        hen = mydo & "-" & myhun & "-" & mybyou
            If ang2 < 0 Then
            hen = "-" & hen
            End If
        Case "3"
        hen = mydo & "°" & myhun & "′" & mybyou & "″"
            If ang2 < 0 Then
            hen = "-" & hen
            End If
    End Select
End Function

 ラジアンを度分秒に変換を作ろうと思ったのですが、
とりあえず、前に度単位にした角度を度分秒に表示しなおす関数を作って見ました。
ご利用は動作等をご確認の上、自己責任でお願いします。

'----------------------------------------------------------------------

    '度を度.分秒
    '60.51 --＞60.3036

'----------------------------------------------------------------------

Public Function dms(ang As String) As String

Dim myang As Double
Dim mydo As String
Dim myhun As String
Dim mybyou As String
Dim mybyou2 As Double
Dim ang2 As Double

 ang2 = CDbl(ang)               '符号判定用
    myang = Abs(ang2)            '符号を消す
    mybyou2 = Format(myang * 3600, "0.00 ") '度を秒に変換 この時点で計算誤差を四捨五入
    mybyou2 = Format(mybyou2, "0 ")
    mydo = Int(myang)                       '整数部分の抽出（度）
    myhun = Format(Int((mybyou2 - (mydo * 3600)) / 60), "00")   '整数部分を抽出（分）
    mybyou = Format(mybyou2 - (mydo * 3600 + myhun * 60), "00") '（度）（分）を秒に変換し、全体から引き残りが（秒）
   
    dms = mydo & "." & myhun & mybyou  '結合
   
    If ang2 > 0 Then            '符号を戻す
        dms = Format(dms, "0.0000")
    Else
        dms = Format(-dms, "0.0000")
    End If
End Function