前回作成したマクロは、ループの書き方がカッコ悪い感じです。再帰関数を使って、少し見やすくしてみます。
ついでに無駄な計算を少し省略します。以下の2つは省略可能です。
- 四則演算のうち、足し算と掛け算は可換なので半分は不要
- 1回目の計算と2回目の計算が交換できる場合も半分は不要
ソースコードはご自由にご利用ください。ただし、趣味のプログラムなので保証はありません。
'------------------------------
Option Explicit
Dim row As Long
Dim col As Long
Const epsilon As Double = 0.000001
Public Sub Calc10()
Sheet1.Cells.Clear
row = 1
col = 1
Call Calc10B(3, 4, 7, 8)
End Sub
'再帰関数を使う場合
Public Sub Calc10B(a0 As Long, a1 As Long, a2 As Long, a3 As Long)
Dim a(6) As Double
Dim op(2) As Long '演算子のIndex
Dim nm(5) As Long '数字のIndex
a(0) = a0
a(1) = a1
a(2) = a2
a(3) = a3
a(4) = 0
a(5) = 0
a(6) = 0
Call Calc10B_iterate(a, op, nm, 0)
End Sub
Public Sub Calc10B_iterate(ByRef a() As Double, ByRef op() As Long, ByRef nm() As Long, cnt As Long)
Dim i As Long
Dim j As Long
Dim k As Long
Dim l As Long
If cnt < 3 Then
'----- Operator -----
For i = 0 To 3
op(cnt) = i
'----- 1st number -----
For j = 0 To 3 + cnt
For l = 0 To 2 * cnt - 1
If j = nm(l) Then
Exit For
End If
Next l
If l <> 2 * cnt Then
GoTo label0
End If
nm(l) = j
'----- 2nd number -----
For k = 0 To 3 + cnt
For l = 0 To 2 * cnt
If k = nm(l) Then
Exit For
End If
Next l
If l <> 2 * cnt + 1 Then
GoTo label1
End If
nm(l) = k
'演算子が交換可能なとき
If (i = 0 Or i = 2) And k < j Then
GoTo label1
End If
'1回目の演算と2回目の演算が交換可能なとき
'((a0,a1),(a2,a3)), ((a0,a2),(a1,a3)), ((a0,a3),(a1,a2)) の組み合わせは計算する
'((a1,a2),(a0+a3)), ((a1,a3),(a0,a2)), ((a2,a3),(a0,a1)) の組み合わせは計算しない
If cnt = 1 Then
If (j = 0 And (k = 1 Or k = 2 Or k = 3)) _
Or ((j = 1 Or j = 2 Or j = 3) And k = 0) Then
GoTo label1
End If
End If
'----- Operation -----
a(4 + cnt) = OperationCalc(i, a(j), a(k))
'----------
Call Calc10B_iterate(a, op, nm, cnt + 1)
label1:
Next k
'----------
label0:
Next j
'----------
Next i
'----------
ElseIf cnt = 3 Then
Call Calc10B_result(a, op, nm)
End If
End Sub
Public Sub Calc10B_result(ByRef a() As Double, ByRef op() As Long, ByRef nm() As Long)
'---------- 1回目の演算 ----------
Sheet1.Cells(row, col + 0) = OperationText(op(0))
Sheet1.Cells(row, col + 1) = a(nm(0))
Sheet1.Cells(row, col + 2) = a(nm(1))
col = col + 3
If op(0) = 3 And Math.Abs(a(nm(1))) < epsilon Then
Sheet1.Cells(row, col) = "Divided by Zero"
GoTo label
End If
'---------- 2回目の演算 ----------
Sheet1.Cells(row, col + 0) = OperationText(op(1))
Sheet1.Cells(row, col + 1) = a(nm(2))
Sheet1.Cells(row, col + 2) = a(nm(3))
col = col + 3
If op(1) = 3 And Math.Abs(a(nm(3))) < epsilon Then
Sheet1.Cells(row, col) = "Divided by Zero"
GoTo label
End If
'---------- 3回目の演算 ----------
Sheet1.Cells(row, col + 0) = OperationText(op(2))
Sheet1.Cells(row, col + 1) = a(nm(4))
Sheet1.Cells(row, col + 2) = a(nm(5))
col = col + 3
If op(2) = 3 And Math.Abs(a(nm(5))) < epsilon Then
Sheet1.Cells(row, col) = "Divided by Zero"
GoTo label
End If
'------------------------------
Sheet1.Cells(row, col) = a(6)
label:
row = row + 1
col = 1
End Sub
0 件のコメント:
コメントを投稿