分数类

weixing1531

最近在学习类模块
手痒就试着编写了一个分数类
初学
不足之处请多多指教

以下为源代码：
类模块代码

1. '类模块 (名称) 改为 Rational
   
2. 'Creat 构造方法
   
3. 'RalAddRal RalAddNum 加法 函数
   
4. 'RalSubRal RalSubNum 减法 函数
   
5. 'RalTimesRal RalTimesNum 乘法 函数
   
6. 'RalDivRal RalDivNum 除法 函数
   
7. 'RalPowerInt 乘方 函数
   
8. 'Negative 相反数 函数
   
9. 'Real2Ral 浮点数转换为分数 子程序
   
10. 'Ral2Real 分数转换为双精度浮点数 函数
    
11. 'Output 打印 子程序
    
12. Option Explicit
    
13. Private num_&   '分子 &代表长整数 4字节 下同
    
14. Private denom_& '分母
    
15. 
    
16. Private Sub Class_Initialize() '指定分数初始值
    
17.   num_ = 0
    
18.   denom_ = 1
    
19. End Sub
    
20. '个人认为写操作用子程序比用属性更安全
    
21. Public Sub Setnum(x&) '写分子 子程序
    
22.   num_ = x
    
23. End Sub
    
24. 
    
25. Public Sub Setdenom(y&) '写分母 子程序
    
26.   denom_ = y
    
27. End Sub
    
28. '属性只可读
    
29. Public Property Get num&() '读分子 属性
    
30.   num = num_
    
31. End Property
    
32. 
    
33. Public Property Get denom&() '读分母 属性
    
34.   denom = denom_
    
35. End Property
    
36. 
    
37. Public Sub Creat(x&, Optional y&) '构造方法
    
38.   num_ = x
    
39.   
    
40.   If IsMissing(y) Then '不传入分母
    
41.     denom_ = 1 '分母默认为1
    
42.   Else '传入分母
    
43.     If (y <= 0) Then
    
44.       MsgBox "分母不能为非正数！", vbExclamation
    
45.       End ' 提前结束程序
    
46.     End If
    
47. 
    
48.     denom_ = y
    
49.   End If
    
50.   
    
51.   'Call Reduse(Me) '这里暂不进行约分
    
52. End Sub
    
53. 
    
54. Private Function Gcv&(a&, b&) '返回最大公约数
    
55.   Dim big&, small&, temp&
    
56. 
    
57.   big = Application.Max(a, b) 'VBA居然没有内置max min函数
    
58.   small = Application.Min(a, b)
    
59. 
    
60.   Do While (small > 1) '辗转除法
    
61.     temp = big Mod small
    
62.     If temp = 0 Then Exit Do
    
63.     big = small
    
64.     small = temp
    
65.   Loop
    
66. 
    
67.   Gcv = small
    
68. End Function
    
69.   
    
70. Private Sub Reduse(a As Rational) '约分 调用后改变了a
    
71.     Dim b&, sign&
    
72. 
    
73.     If a.denom = 0 Then
    
74.       MsgBox "分母不能为0！", vbExclamation
    
75.       End ' 提前结束程序
    
76.     End If
    
77. 
    
78.     If a.num = 0 Then   '分子为0
    
79.       Call a.Setdenom(1)  '分母强制为1
    
80.       Exit Sub '提前返回
    
81.     End If
    
82. 
    
83.     'If a.num * a.denom > 0 Then '同号 积超大可能会溢出
    
84.     If (a.num > 0 And a.denom > 0) Or (a.num < 0 And a.denom < 0) Then '同号
    
85.       sign = 1
    
86.     Else '异号
    
87.       sign = -1
    
88.     End If
    
89. 
    
90.     Call a.Setnum(Abs(a.num))   '正分子
    
91.     Call a.Setdenom(Abs(a.denom)) '正分母
    
92.     b = Gcv(a.num, a.denom) '最大公约数
    
93. 
    
94.     Call a.Setnum(a.num / b * sign)   '分子带符号
    
95.     Call a.Setdenom(a.denom / b)  '保证分母始终为正
    
96. End Sub
    
97.   
    
98. Public Function RalAddRal(b As Rational) As Rational '加法
    
99.   Set RalAddRal = New Rational '对象实例
    
100.   
     
101.   Call RalAddRal.Setnum(num_ * b.denom + b.num * denom_)
     
102.   Call RalAddRal.Setdenom(denom_ * b.denom)   '通分
     
103.   Call Reduse(RalAddRal)  '约分
     
104. End Function
     
105. 
     
106. Public Function RalAddNum(b As Variant) As Rational '加法
     
107.   '利用VarType实现简单重载 b可以为整数、浮点数
     
108.   Select Case VarType(b)  'VarType返回变体的具体类型
     
109.   Case vbInteger, vbLong, vbByte 'Integer Long Byte整数
     
110.     Set RalAddNum = New Rational '对象实例
     
111.     Call RalAddNum.Setnum(num_ + denom_ * b)
     
112.     Call RalAddNum.Setdenom(denom_)
     
113.     Call Reduse(RalAddNum)  '约分
     
114.   Case vbDouble, vbSingle '双、单精度浮点数
     
115.     Dim temp As New Rational
     
116.     Call temp.Real2Ral(CDbl(b)) 'CDbl将变体类型转换为双精度浮点数
     
117.     '转换为分数相加 单精度转换为分数可能误差较大
     
118.     Set RalAddNum = Me.RalAddRal(temp) 'Me为对象实例
     
119.     '加法已经约分过了
     
120.     Set temp = Nothing
     
121.   Case Else
     
122.     MsgBox "类型错误!", vbExclamation
     
123.     End ' 提前结束程序
     
124.   End Select
     
125. End Function
     
126. 
     
127. Public Function RalSubRal(b As Rational) As Rational '减法
     
128.   Set RalSubRal = New Rational '对象实例
     
129.   
     
130.   Call RalSubRal.Setnum(num_ * b.denom - b.num * denom_)
     
131.   Call RalSubRal.Setdenom(denom_ * b.denom)   '通分
     
132.   Call Reduse(RalSubRal)  '约分
     
133. End Function
     
134. 
     
135. Public Function RalSubNum(b As Variant) As Rational '减法
     
136.   'a-b=a+(-b)
     
137.   Set RalSubNum = Me.RalAddNum(-b) 'Me为对象实例
     
138. End Function
     
139. 
     
140. Public Function RalTimesRal(b As Rational) As Rational '乘法
     
141.   Set RalTimesRal = New Rational '对象实例
     
142.   
     
143.   Call RalTimesRal.Setnum(num_ * b.num)
     
144.   Call RalTimesRal.Setdenom(denom_ * b.denom)
     
145.   Call Reduse(RalTimesRal)  '约分
     
146. End Function
     
147. 
     
148. Public Function RalTimesNum(b As Variant) As Rational '乘法
     
149.   '利用VarType实现简单重载 b可以为整数、浮点数
     
150.   Select Case VarType(b)  'VarType返回变体的具体类型
     
151.   Case vbInteger, vbLong, vbByte 'Integer Long Byte整数
     
152.     Set RalTimesNum = New Rational '对象实例
     
153.     Call RalTimesNum.Setnum(num_ * b)
     
154.     Call RalTimesNum.Setdenom(denom_)
     
155.     Call Reduse(RalTimesNum)  '约分
     
156.   Case vbDouble, vbSingle '双、单精度浮点数
     
157.     Dim temp As New Rational
     
158.     Call temp.Real2Ral(CDbl(b)) 'CDbl将变体类型转换为双精度浮点数
     
159.     '转换为分数相乘 单精度转换为分数可能误差较大
     
160.     Set RalTimesNum = Me.RalTimesRal(temp) 'Me为对象实例
     
161.     '乘法已经约分过了
     
162.     Set temp = Nothing
     
163.   Case Else
     
164.     MsgBox "类型错误!", vbExclamation
     
165.     End ' 提前结束程序
     
166.   End Select
     
167. End Function
     
168. 
     
169. Public Function RalDivRal(b As Rational) As Rational '除法
     
170.   Set RalDivRal = New Rational '对象实例
     
171.   
     
172.   Call RalDivRal.Setnum(num_ * b.denom)
     
173.   Call RalDivRal.Setdenom(denom_ * b.num)
     
174.   Call Reduse(RalDivRal)  '约分
     
175. End Function
     
176. 
     
177. Public Function RalDivNum(b As Variant) As Rational '除法
     
178.   '利用VarType实现简单重载 b可以为整数、浮点数
     
179.   Select Case VarType(b)  'VarType返回变体的具体类型
     
180.   Case vbInteger, vbLong, vbByte 'Integer Long Byte整数
     
181.     Set RalDivNum = New Rational '对象实例
     
182.     Call RalDivNum.Setnum(num_)
     
183.     Call RalDivNum.Setdenom(denom_ * b)
     
184.     Call Reduse(RalDivNum)  '约分
     
185.   Case vbDouble, vbSingle '双、单精度浮点数
     
186.     Dim temp As New Rational
     
187.     Call temp.Real2Ral(CDbl(b)) 'CDbl将变体类型转换为双精度浮点数
     
188.     '转换为分数相除 单精度转换为分数可能误差较大
     
189.     Set RalDivNum = Me.RalDivRal(temp) 'Me为对象实例
     
190.     '乘法已经约分过了
     
191.     Set temp = Nothing
     
192.   Case Else
     
193.     MsgBox "类型错误!", vbExclamation
     
194.     End ' 提前结束程序
     
195.   End Select
     
196. End Function
     
197. 
     
198. Public Function RalPowerInt(b&) As Rational '乘方
     
199.   Set RalPowerInt = New Rational '对象实例
     
200.   
     
201.   If b > 0 Then
     
202.     Call RalPowerInt.Setnum(num_ ^ b)
     
203.     Call RalPowerInt.Setdenom(denom_ ^ b)
     
204.   ElseIf b < 0 Then
     
205.     Call RalPowerInt.Setnum(denom_ ^ (-b))
     
206.     Call RalPowerInt.Setdenom(num_ ^ (-b))
     
207.   Else 'b==0  0^1=1
     
208.     Call RalPowerInt.Setnum(1)
     
209.     Call RalPowerInt.Setdenom(1)
     
210.     Exit Function '提前返回
     
211.   End If
     
212.   
     
213.   Call Reduse(RalPowerInt)  '约分
     
214. End Function
     
215. '浮点数转换为分数
     
216. '应该会有更好的算法 这里用的是暴力转换
     
217. Public Sub Real2Ral(a As Double)
     
218.   Const N As Long = 100000
     
219.   Dim i As Long
     
220.    
     
221.   i = Fix(a)  '取整 去尾
     
222.   denom_ = N  '假定分母超大
     
223.   num_ = CLng((a - i) * N)  '小数部分扩大N倍后四舍五入
     
224.   Call Reduse(Me) '约分后一定真分数
     
225.   num_ = num_ + i * denom_ '真分数叠加整数
     
226. End Sub
     
227. '分数转换为双精度浮点数
     
228. Public Function Ral2Real() As Double
     
229.   If denom_ = 0 Then
     
230.     MsgBox "分母为0！", vbExclamation
     
231.     End ' 提前结束程序
     
232.   End If
     
233.   
     
234.   Ral2Real = num_ / denom_
     
235. End Function
     
236. 
     
237. Public Function Negative() As Rational  '相反数　取负
     
238.   Set Negative = New Rational '对象实例
     
239.   Call Negative.Setdenom(denom_)
     
240.   Call Negative.Setnum(-num_)
     
241. End Function
     
242. 
     
243. Public Sub Output() '打印
     
244.   Debug.Print num_ & "/" & denom_ '立即窗口显示结果
     
245. End Sub

复制代码

标准模块代码

1. Option Explicit
   
2. 
   
3. Sub main()
   
4.   Dim a As New Rational '对象实例
   
5.   Dim b As New Rational '对象实例
   
6.   Dim c As Rational 'c是引用 下同
   
7. 
   
8.   Call a.Creat(1, 2)
   
9.   Call a.Output
   
10.   Call b.Creat(1, 3)
    
11.   Call b.Output
    
12.   Set c = a.RalAddRal(b) '分数加分数
    
13.   Call c.Output '打印
    
14.   Set c = a.RalAddNum(2.25) '分数加数字
    
15.   Call c.Output '打印
    
16.   Set c = a.RalSubRal(b) '分数减分数
    
17.   Call c.Output
    
18.   Set c = a.RalSubNum(2.25) '分数减数字
    
19.   Call c.Output '打印
    
20.   Set c = a.RalTimesRal(b) '分数乘分数
    
21.   Call c.Output
    
22.   Set c = a.RalTimesNum(2.25) '分数乘数字
    
23.   Call c.Output '打印
    
24.   Set c = a.RalDivRal(b) '分数除以分数
    
25.   Call c.Output
    
26.   Set c = a.RalDivNum(2.25) '分数除以数字
    
27.   Call c.Output '打印
    
28.   Set c = a.RalPowerInt(3) '乘方
    
29.   Call c.Output
    
30.   Set c = a.Negative() '取相反数
    
31.   Call c.Output
    
32.   Call c.Real2Ral(-1.125) '浮点数转换为分数
    
33.   Call c.Output
    
34. End Sub
    

复制代码

分数类型（试验）.zip (26.04 KB, 下载次数: 7)

2019-12-4 18:31 上传

点击文件名下载附件
Excel文件

weixing1531

以下是分数类型正式版1.0  
加入了比较逻辑函数