Function fenshu(ByVal xiaoshu As Single, Optional ByVal jingdu As Integer = 3) As String '小数转换为分数，误差小于0.1^jingdu
Dim i As Long
Do
i = i + 1
Loop Until Abs((i / xiaoshu) - Round((i / xiaoshu), 0)) < 0.1 ^ jingdu
fenshu = i & "/" & Round(i / xiaoshu)
End Function
Function xiaoshu(ByVal fenshu As String) As String '将N/D形式（其中N为分子，D为分母）的分数转换为小数，如果为无限循环小数则用括号将循环节括起来
Dim N As Long, D As Long
N = CLng(Split(fenshu, "/")(0))
D = CLng(Split(fenshu, "/")(1))
If N Mod D = 0 Then '整除
xiaoshu = N / D
Exit Function
Else
Dim digit() As String, flag() As Long, temp As Double, temp2 As Long, i As Long, K As Integer
ReDim digit(1 To D + Len(CStr(D))) '定义最长不重复位数
ReDim flag(D) '0-D 每位数字出现于小数点后的位置
xiaoshu = Int(N / D) & "."
temp = N Mod D '取余
i = 2
Do While i <= D + Len(CStr(D)) '循环所有可能
If temp = 0 Then '除尽了
ReDim Preserve digit(1 To i) '前i位
xiaoshu = xiaoshu & Join(digit, "")
Exit Function
End If
If flag(temp) > 1 Then '重复出现
digit(flag(temp)) = "(" & digit(flag(temp)) 'flag(temp)指该数字第一次出现的位置，添加左括号
ReDim Preserve digit(1 To i - 1)
xiaoshu = xiaoshu & Join(digit, "") & ")" '添加右括号
Exit Function
Else
flag(temp) = i '赋值
End If
'以下三行模拟除法运算，实现高精度除法
temp = temp * 10
digit(i) = Int(temp / D) Mod 10
temp = temp - Int(temp / D) * D
i = i + 1
Loop
End If
End Function
Private Sub Command1_Click()
Dim i As Integer, x() As String
ReDim x(1 To 6) '小数到分数
For i = 1 To 6
x(i) = fenshu(3.14159265358979, i) & "(误差小于1/" & 10 ^ (i - 1) & " )"
Next
MsgBox Join(x, vbCrLf), vbInformation, "圆周率"
ReDim x(1 To 17) '分数到小数
For i = 1 To 17
x(i) = Right(" " & i, 2) & "/17=" & xiaoshu(i & "/17")
Next
MsgBox Join(x, vbCrLf), vbInformation, "17的循环节"
End Sub