第８話 ユークリッド互除法を利用して分数の足し算を実行してさらに約分できる場合には約分するマクロ例
を実現するプログラム例
Private Sub CommandButton1_Click()
Rows("6:2000").Select
Selection.ClearContents
Cells(1, 1).Select
Dim a(14) As Integer
a(0) = f 'a
a(1) = f 'b
a(4) = a(0) 'aのバックアップ
a(5) = a(1) 'bのバックアップ
tobi:
a(2) = f 'c
a(3) = f 'd
a(6) = a(2) 'cのバックアップ
a(7) = a(3) 'dのバックアップ
If a(3) > a(2) Then Call g(a(2), a(3))
a(8) = h(a(2), a(3)) 'cとdの最大公約数
If a(8) = 1 Then GoTo tobi
Cells(4, 2) = a(4)
Cells(4, 4) = a(5)
Cells(5, 2) = a(6)
Cells(5, 4) = a(7)
a(9) = Int((a(6) / a(8)) * a(7)) 'cとdの最小公倍数
a(10) = a(4) * Int(a(9) / a(6)) + a(5) * Int(a(9) / a(7)) '分数を足したときの分子
Cells(4, 6) = a(10)
Cells(5, 6) = a(9)
a(11) = a(10) '分子のバックアップ
a(12) = a(9) '分母のバックアップ
If a(10) > a(9) Then Call g(a(10), a(9))
a(13) = h(a(10), a(9)) '足し算結果の分母と分子の最大公約数
Cells(4, 8) = Int(a(11) / a(13))
Cells(5, 8) = Int(a(12) / a(13))
End Sub
Function f()
tobi:
f = Int(100 * Rnd)
If f = 0 Then GoTo tobi
End Function
Sub g(a As Integer, b As Integer)
Dim w As Integer
w = a
a = b
b = w
End Sub
Function h(a As Integer, b As Integer)
a = a Mod b
If a = 0 Then
h = b
Exit Function
End If
h = h(b, a)
End Function
Private Sub CommandButton2_Click()
Range("B4,B5,D4,D5,F4,F5,H4,H5").Select
Selection.ClearContents
Cells(1, 1).Select
End Sub
参考ダウンロード添付ファイル
ユークリッド互除法は、結構面白いテーマだと思いませんか。
まだまだ、いろいろなマクロが組めそうですが、
それは、皆さんにお任せして、
第12講のFor文以外の繰り返し処理に進みたいと思います。
