'有効桁数で丸め、小数点位置がそろうようにフォーマットする関数

'iNum_Digits1に有効桁数、iNum_Digits2に小数部桁数を指定します。
'セル書式は固定ピッチフォント、右詰めにしてください。

'使用例
'      A            B
' 1    1234  =FmtPt2(A1,3,4)
' 2   1.234  =FmtPt2(A2,3,4)
' 3  0.1234  =FmtPt2(A3,3,4)

Option Explicit

Function FmtPt2(dfNumber As Double, iNum_Digits1 As Integer, _
        iNum_Digits2 As Integer) As Variant
    Dim sNumber As String
    Dim dfIntNum As Double
    Dim iNum1 As Integer
    Dim iExponent  As Integer
    Dim iNum_Digits3 As Integer
    Dim sFormat As String

    '引数のチェック
    If iNum_Digits1 <= 0 Or iNum_Digits2 < 0 Then
        FmtPt2 = CVErr(xlErrValue)
        Exit Function
    End If

    '数値を15桁の文字列に変換
    sNumber = Mid$(Format$(Abs(dfNumber), ".000000000000000E+000"), 2)

    '仮数部を整数として取得
    dfIntNum = CDbl(Left$(sNumber, 15))

    '指数部を取得
    iExponent = CInt(Mid$(sNumber, 17, 4))

    '有効桁の最終桁位置を取得
    iNum_Digits3 = -1 * (iExponent - iNum_Digits1)

    '指定小数桁数で有効桁を表示できない場合はエラーを返す
    If iNum_Digits3 > iNum_Digits2 Then
        FmtPt2 = CVErr(xlErrValue)
        Exit Function
    End If

    '指定桁-1の数字を取得
    If (iNum_Digits1 < 0) Or (iNum_Digits1 >= 15) Then
        iNum1 = 0
    Else
        iNum1 = CInt(Mid$(sNumber, iNum_Digits1 + 1, 1))
    End If

    '丸め
    If iNum1 < 5 Then
        dfIntNum = Int(dfIntNum / (10 ^ (15 - iNum_Digits1))) * (10 ^ (iExponent - iNum_Digits1)) * Sgn(dfNumber)
    Else
        dfIntNum = (Int(dfIntNum / (10 ^ (15 - iNum_Digits1))) + 1) * (10 ^ (iExponent - iNum_Digits1)) * Sgn(dfNumber)
    End If

    '書式文字列の作成
    If dfIntNum = 0 Then
        iNum_Digits3 = iNum_Digits3 - 1
    End If
    If iNum_Digits3 <= 0 Then
        sFormat = "0_." & Application.Rept("_0", iNum_Digits2)
    Else
        sFormat = "0." & Application.Rept("0", iNum_Digits3) & _
            Application.Rept("_0", iNum_Digits2 - iNum_Digits3)
    End If

    FmtPt2 = Application.Text(dfIntNum, sFormat)
End Function