滝の音

滝の音

名こそ流れてなお聞こえけれ

計算プリント 第一回統合 その2 (3数の計算)

はじめに

今回は「3数の計算」を統合します。
これも懐かしいです。

統合してみる

「3数の計算」はいうなれば「繰り返し系」です。
「無作為系」との統合は今回はやめておきます。
Literal2クラスとLit系の関数に対応させましょう。

Formula_Make_B

Function Formula_Make_B(NN) As String
'-------------------
'文字式の計算式を作成する
'-------------------

'------------------
'変数の定義
'------------------
 Dim ope() As String        '演算子
 Dim kou() As Literal2      '数値
 Dim i As Integer           '繰り返しの制御変数
 Dim str As String          '計算式
 Dim str1 As String         '右辺
 Dim str2 As String         '左辺
 Dim ans()  As Literal2     '計算式の答え
 Dim cnt As Integer         'ReDoのアシスト変数
 Dim flag As Boolean
 
 
ReSelect:
 cnt = 0
'------------------
'kou,opeを指定
'------------------
 ReDim kou(1 To NN)
 ReDim ope(1 To NN)
 
 For i = 1 To NN
    Set kou(i) = Lit_Kou_Select(1, 1, 1)
    ope(i) = Lit_Ope_Select(3)
 Next
 ope(NN) = ""
 
 
 Do
    
    '------------------
    'Loopの初期設定
    '------------------
    flag = False
    
    '------------------
    '停滞している場合
    '------------------
    If cnt > 20 Then
        GoTo ReSelect
    End If
    
    '------------------
    'str1を作成
    '------------------
     str1 = Lit_Str_Make(kou, ope)
     
    '------------------
    'ansを配列で取得
    '------------------
     ans = Lit_Str_Analyze(str1)
     ans(0).Fit
    '-----------------
    'ansを判定
    '-----------------
    flag = Int_ReDo_Jdg_(kou, ope, ans(0))
    cnt = cnt + 1

 Loop While flag = True
 
'------------------
'str2を作成
'------------------
 ReDim ope(LBound(ans) To UBound(ans))
 
 For i = LBound(ans) To UBound(ans) - 1
    ope(i) = "+"
 Next
 
 str2 = Lit_Str_Make(ans, ope)
 
 
'------------------
'str2の修飾
'------------------
 str2 = Replace(str2, "(", "")
 str2 = Replace(str2, ")", "")
 If left(str2, 2) = "0+" Then
    str2 = Mid(str2, 3)
 End If
 
 If Right(str2, 1) = "+" Then
    str2 = left(str2, Len(str2) - 1)
 End If
 str2 = Replace(str2, "+-", "-")

'------------------
'戻り値を作成
'------------------
 str = str1 & "=" & str2
 Formula_Make_B = str
End Function

基本的にはLit系の関数からなっています。

Int_ReDo_Jdg

本当はこれの分数バージョンもあったほうが良いのですが、それはまだ保留で。

Function Int_ReDo_Jdg_(ByRef kou, ope, ans) As Boolean
'-------------------------
'ansを考慮して
'必要な場合はnumの値を変更
'--------------------------

'--------------------------
'変数の定義
'--------------------------
 Dim i As Integer
 
 ans.Fit
'--------------------------
'ansが負の数の場合
'--------------------------
 If ans.Va < 0 Then
 
    For i = LBound(ope) To UBound(ope)
       If ope(i) = "-" Then
           ope(i) = "+"
       ElseIf ope(i) = "+" Then
           ope(i) = "-"
       End If
    Next
    
    Int_ReDo_Jdg_ = True
    Exit Function
 End If
'--------------------------
'ansが分数の場合
'--------------------------

 If ans.Vb <> 1 Then
    kou(1).Va = kou(1).Va * ans.Vb
    
    For i = 1 To UBound(kou) - 1
       If ope(i) = "+" Or ope(i) = "-" Then
           kou(i + 1).Va = kou(i + 1).Va * ans.Vb
       End If
    Next
    Int_ReDo_Jdg_ = True
    Exit Function
 End If
   
'--------------------------
'ansが100より大きい場合
'--------------------------
 If ans.Va > 100 Then
    For i = 1 To UBound(kou) - 1
        If ope(i) <> "÷" Then
            kou(i).Va = Application.WorksheetFunction.Max(2, kou(i).Va \ 2)
        End If
    Next
    kou(i).Va = Application.WorksheetFunction.Max(2, kou(i).Va - ans.Va \ 3)
    Int_ReDo_Jdg_ = True
    Exit Function
    
 End If
End Function

原因はわからないのですが、「Ans.Vb」をきちんと読み込んでくれない事案が発生して困っていました。
「ans.Fit」を入れたら解決したのですが、謎。。

まとめ

今回はそれほど恩恵の大きい回ではありませんでしたが、Int系の関数をいくつか減らしました。

次回は「数値指定系」に触れます。