滝の音

滝の音

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

久しぶりの更新

なんとなくブログを再開。
どうもお久しぶりです(誰に向けたメッセージ?)。

とりあえず現状

かつてはベンチプレスの記録をあげたり、VBAのコードを載せてたりしておりました。
とりあえずそれらの現状報告。

ジム活動はブログ更新とともにストップしてしまいました。 今は体重58kg。筋肉は消滅しました。
おそらくベンチプレス40kgも上がらないでしょう。

VBAで何かを面白い(と自分が思うことを)書くこともブログとともにストップ。
全然書かなくなってしまったというか、空いている時間をプログラミングに回さなくなったというか。。

一応かつてのブログ更新者と同一人物なのですが、やっていることは昔と全然違いますね。。

では今は何をやっているのか。

ドラッガーの本を読んでおります。
個別指導塾で労働をしております。
フリーの家庭教師をしております。
株取引でボコボコにされております。
独立して教育産業で飯を食べたいなぁと思っております。
U-NEXTで海外ドラマを見ております。

実はVBAは塾でたまーーーに使っております。
人が手作業で行っているお仕事をすこーーしずつプログラミングに移項させております。
課題が決まってしまっていること、プログラムを書く時間はあまり設けてもらえないこと、などから進行はゆっくりですが。

何が面白いかな

「塾の中にいて思うこと」を記事に書いていくのが面白いかなーー。
今またVBAでプログラムを書いたら面白いかなーー。
ガリガリから何か月で元の状態に戻れるか検証したら面白いかなーー。

発散しちゃっております。
刈り取らないとあちこちに栄養を持っていかれて何一つ残らないことは経験済み。

選択と集中をせねば。。

せっかくなので

ほんとに何となく記事を書いているのですが、せっかくなので今決めますか。
2020年残り4か月何をするか。
1つに決めますか。

んんーー。

「中学理科攻略プログラム」
にしますか。

記事の書き始めでは「VBAで迷路を作ろう」を書こうと思っていたのですが。
実は第3回の投稿までのコードをすでに作っているのですが。

それらはとりあえず眠らせましょう。

これからはかなーーり教育産業よりの記事を書き続けることになりそう。
自分の思考整理のためにもちょうどよいかな。
形にしてみましょう。

あ。
Markdownの書き方もかなーーり忘れているのでこの記事は読みにくいかもです。
まぁそのあたりもこれからリハビリ。

計算プリントを自動生成する 一次方程式 その4(計算プリントを生成)

はじめに

今回は今まで作った関数を組み合わせるだけです。
未知との互換性が高い関数が書ければめちゃくちゃ簡単な作業なのですが。

関数

ひながたB

まずは表現系から。

Sub ひながた_B()
Randomize

'------------------------------
'0. 扱う変数の定義
'------------------------------
 Dim N As Integer       '問題数を決める変数
 Dim i As Integer       '繰り返しの制御変数
 Dim str() As String    '計算式の文字列

'------------------------------
'1. 問題数の指定
'------------------------------
 N = 4
 
 For i = 1 To N
    '------------------------------
    '2. 問題を指定して式を求める
    '------------------------------
    str = Equation_Make_A()
    
    '------------------------------
    '3. 出力
    '------------------------------
    Sheets("Sheet1").Activate
    Call Equation_Express(str, i)
    
    
 Next

End Sub

Equation_Expression

いろいろ数値の調整が必要で見た目が散らかるため、サブ関数化しました。

Function Equation_Express(str, num)
'------------------
'複数の式を出力
'------------------

'------------------
'変数の定義
'------------------
 Dim i As Integer
 Dim inter As Integer
 Dim px As Integer
 Dim py As Integer
 Dim loc As Integer
 Dim tmp As Integer
'------------------
'値の指定
'------------------
 
 inter = UBound(str) - LBound(str) + 2
 inter = inter * 30 + 10

 px = (num - 1) Mod 2
 px = 20 + px * 150
 py = (num - 1) \ 2
 py = py * inter
 
 loc = InStr(str(1), "=")
 
'-------------------
'挿入
'-------------------
 For i = LBound(str) To UBound(str)
    If str(i) = "" Then Exit For
    tmp = loc - InStr(str(i), "=")
    tmp = tmp * 10
    Call Insert_Str(px + tmp, py + 30 * i, str(i))
 Next
 
End Function

Equation_Make_A

Function Equation_Make_A() As String()
'-------------------
'文字式の方程式を作成する
'-------------------
 NN = 2
'------------------
'変数の定義
'------------------
 Dim ope() As String        '演算子
 Dim kou() As Literal2      '数値
 Dim ope_() As String       'hen作成のアシスト変数
 Dim kou_() As Literal2     'hen作成のアシスト変数
 Dim i As Integer           '繰り返しの制御変数
 Dim j As Integer           '繰り返しの制御変数
 Dim hen(1 To 2) As String  '右辺と左辺
 Dim str As String          '第1式
 
ReSelect:
 
 ReDim kou(1 To 2, 1 To NN)
 ReDim ope(1 To 2, 1 To NN)
 
'------------------
'kou,opeを指定
'------------------
 For i = 1 To 2

    ReDim kou_(1 To NN)
    ReDim ope_(1 To NN)
     
    For j = 1 To NN
        Set kou(i, j) = Lit_Kou_Select(2, 1, 2)
        Set kou_(i) = kou(i, j)
    Next
    ope(i, 1) = "+"
    ope(i, 2) = ""
 Next
 
'------------------
'kouのチェック
'------------------
 flag = False
 flag = Equ_ReDo_Jdg(kou)
 
 If flag = True Then GoTo ReSelect

'------------------
'数値の調整
'------------------
 Call Equ_kou_Adjust(kou)
 
'------------------
'henの生成
'------------------
 For i = 1 To 2
 
    For j = 1 To NN
        Set kou_(j) = kou(i, j)
        ope_(j) = ope(i, j)
    Next
    
    hen(i) = Lit_Str_Make(kou_, ope_, 0)
 Next
 
 str = hen(1) & "=" & hen(2)

'------------------
'戻り値
'------------------
 
 Equation_Make_A = Equ_Analyze(str)
 
End Function

ここに含まれているサブ関数は以前に書いた通りです。

ちょっぴり感想

なんだか。
泳いでいるときに息が苦しくなって。
そのせいで動きも息継ぎも悪くなってもっと苦しくなる。
そんないっぱいいっぱいな仕様になっています。

もっと優雅に泳げれば楽しいのかなと思います。

これはプログラミング技術がどうこうっていうより、もっと根幹にある問題だと思います。

チープに言えば「計画性」です。

ずっと体力をつける練習はしているけど、計画性を磨く練習はしていない気がします。

ってことを昔にも思ったはずなのですが。
まだまだ厳しいです。

まとめ

これで「一次方程式」はいったん終わりです。

この企画もだいぶ書き進めましたね。
たぶん50回くらい投稿していますー。

次回は息抜きがてら、この企画をやっていて思うこと、反省などを書きます。

計算プリントを自動生成する 一次方程式 その3(値の調整)

はじめに

現状の関数のみでは、解が分数の問題ばかりができてしまいます。
なので「値の調整」を行いましょう。

願望

「値の調整」はいうなれば、現状の仕組みが弱いから付けざるを得ない付属品です。
そのうちその「仕組み」自体を変更することがあるかもしれないので、その時のために原案を練っておきましょう。
こうなったらいいなぁというものを書いておきます。

方程式に含まれる項のうちの、文字が含まれる項の数を指定できる。
方程式を整理した後の係数を指定できる。

あとふたつくらい「方程式」を実装してから、それらをうまく扱える「仕組み」を作ろうかなと思っています。
それまでは多少のちぐはぐは我慢。

Equ_kou_Adjust

係数を都合の良いように変更する関数です。

Function Equ_kou_Adjust(ByRef kou)
'---------------------
'係数を調整する
'---------------------

'---------------------
'変数の定義
'---------------------
 Dim adj As Literal2
 Dim flag As Boolean
 Dim i As Integer
 Dim j As Integer
 
 Set adj = New Literal2
 adj.Va = 0
 adj.Vb = 0
'---------------------
'方程式の調査
'---------------------
ReAdj:

 For i = 1 To 2
    For j = 1 To UBound(kou, 2)
        If kou(i, j).La <> "" Then
            adj.Vb = adj.Vb + kou(i, j).Va * (-1) ^ (i + 1)
        Else
            adj.Va = adj.Va + kou(i, j).Va * (-1) ^ i
        End If
    Next
 Next
 
'----------------------
'調査結果の反映
'----------------------

'----------------------
'ひとつめの対応
'----------------------
 If adj.Vb = 0 Then
    For i = 1 To 2
        For j = 1 To UBound(kou, 2)
            If kou(i, j).La <> "" Then
                kou(i, j).Va = kou(i, j).Va + Rnd_Num(1, 3)
            End If
        Next
    Next
    GoTo ReAdj
 End If
 
 If adj.Va = 0 Then Exit Function
 
 tmp = Abs(adj.Vb)
 adj.Fit
 
'----------------------
'ふたつめの対応
'----------------------
 If tmp > 12 Then
    For i = 1 To 2
       For j = 1 To UBound(kou, 2)
           If kou(i, j).La <> "" Then
               kou(i, j).Va = Application.WorksheetFunction.Max(2, kou(i, j).Va \ 2)
           End If
       Next
    Next
    GoTo ReAdj
 End If
 
'----------------------
'みっつめの対応
'----------------------
 For i = 1 To 2
    For j = 1 To UBound(kou, 2)
        If kou(i, j).La = "" Then
            kou(i, j).Va = kou(i, j).Va * adj.Vb
        End If
    Next
 Next

ReSub:
 flag = False
 
For i = 1 To 2
    For j = 1 To UBound(kou, 2)
        If kou(i, j).La = "" Then
            If kou(i, j).Va > 40 Then
                kou(i, j).Va = kou(i, j).Va - tmp
                flag = True
            ElseIf kou(i, j).Va < -40 Then
                kou(i, j).Va = kou(i, j).Va + tmp
                flag = True
            End If
        End If
    Next
 Next
 
 If flag = True Then GoTo ReSub:

End Function

結構ちぐはぐな関数です。
現状はこれで我慢。

まとめ

「一次方程式」の回は、どの関数もあんまりきれいじゃないですね。
前に作った関数たちとの互換性が薄いからこんなことになるんですね。
でもそれって回避できる問題なのだろうか。。
まだ見ぬ未来の関数とも互換性の良いコードって書けるのだろうか。。

さて、次回は今まで作った関数を組み合わせて、「一次方程式」の計算プリントを作ります。

計算プリントを自動生成する 一次方程式 その2 (解析関数)

はじめに

おなじみの流れです。
最初に問題を生成する関数をつくって。
次に問題を解析する関数を書きます。

手動でやってみる

2a+5=4a-1
-2a=-6
a=3

2列目の式を「-2a=」とするか「2a=」とするかは流派がありそうですね。
自分は後者なのですが、前者のほうがややこしくないかなとも思います。

自動でやってみる

Function Equation_Analyze()

 Dim str As String
 Dim equ() As String
 Dim ans() As Literal2
 Dim ope() As String
 Dim tmp As Integer
 Dim trgt As String
 
 str = "a+5=3a+5"
 
 ReDim equ(1 To 3)
 
 equ(1) = str
'-------------------
'strを修正
'-------------------
 tmp = InStr(str, "=")
 
 For i = tmp To Len(str)
    trgt = Mid(str, i, 1)
    Select Case trgt
        Case Is = "=", "+"
            str = left(str, i - 1) & "-" & Mid(str, i + 1)
        Case Is = "-"
            str = left(str, i - 1) & "+" & Mid(str, i + 1)
    End Select
 Next
 
 ans = Lit_Str_Analyze(str)
 
 
 ReDim ope(LBound(ans) To UBound(ans))
 
 For i = LBound(ans) To UBound(ans) - 1
    ope(i) = "+"
 Next
 
 
 equ(2) = Lit_Str_Make(ans, ope, 0)
 equ(2) = Replace(equ(2), "-", "=")
 equ(2) = Replace(equ(2), "+", "=-")
   
 If ans(1).Va = 0 Then
    equ(2) = equ(2) & "=0"
 End If

 ans(1).Vb = ans(1).Vb * ans(0).Va
 ans(0).Va = 1
 
 equ(3) = Lit_Str_Make(ans, ope, 0)
 equ(3) = Replace(equ(3), "-", "=")
 equ(3) = Replace(equ(3), "+", "=-")
 
 If ans(1).Va = 0 Then
    equ(3) = equ(3) & "=0"
 End If
 
End Function

腕力でつくっちゃいました。
せっかく作った「Lit_Str_Analyze」を使えないかなーと考えたらこんな風になりました。
0への処理はもうちょっとうまくできる気もしますが、今回は保留で。

まとめ

だいたい今までの流れでは。
その時に作れるギリギリのものを作って2,3日眠ると。
それと全然違うもっと良いものを思いついたりするので。

今日の関数はそのための供物みたいなものです。
なんで供物のフェイズを省略できないのかは謎です。

次回は「値の調整」をします。

計算プリントを自動生成する 一次方程式 その1 (問題の自動生成)

はじめに

「方程式」の第一段は「一次方程式」です。
これは昔に何度か扱ったことがあるのですが、今回はそれとは違うアプローチでやりたいですね。

手動で生成してみる

3x+5=x-1
適当に作ってみました。
今までとの違いは3つ。
生成する文字列中に”=”が存在する
文字と数字が少なくとも1項ずつあってほしい
方程式として成立する項の組み合わせであってほしい

このあたりが最初のとっかかりです。

自動で生成する

とりあえず第一案として。

Equation_Make_A

Formula_Make系の方程式バージョンです。

Function Equation_Make_A() As String
'-------------------
'文字式の方程式を作成する
'-------------------
 NN = 2
'------------------
'変数の定義
'------------------
 Dim ope() As String        '演算子
 Dim kou() As Literal2      '数値
 Dim ope_() As String
 Dim kou_() As Literal2
 Dim i As Integer           '繰り返しの制御変数
 Dim j As Integer           '繰り返しの制御変数
 Dim str(1 To 2) As String  '右辺と左辺
 
ReSelect:
 
 ReDim kou(1 To 2, 1 To NN)
 ReDim ope(1 To 2, 1 To NN)
 
'------------------
'kou,opeを指定
'------------------
 For i = 1 To 2

    ReDim kou_(1 To NN)
    ReDim ope_(1 To NN)
     
    For j = 1 To NN
        Set kou(i, j) = Lit_Kou_Select(2, 1, 2)
        Set kou_(i) = kou(i, j)
    Next
    ope(i, 1) = "+"
    ope(i, 2) = ""
 Next
 
'------------------
'kouのチェック
'------------------
 flag = False
 flag = Equ_ReDo_Jdg(kou)
 
 If flag = True Then GoTo ReSelect

'------------------
'strの生成
'------------------
 For i = 1 To 2
 
    For j = 1 To NN
        Set kou_(j) = kou(i, j)
        ope_(j) = ope(i, j)
    Next
    
    str(i) = Lit_Str_Make(kou_, ope_)
    str(i) = Replace(str(i), "(", "")
    str(i) = Replace(str(i), ")", "")
    str(i) = Replace(str(i), "+-", "-")
 Next

'------------------
'strを生成
'------------------
 Equation_Make_A = str(1) & "=" & str(2)
 
End Function

Equ_ReDo_Jdg

基本的にこれを強化していくことになりそう。

Function Equ_ReDo_Jdg(kou) As Boolean
'----------------
'kouが適当かチェック
'----------------

'----------------
'変数の定義
'----------------
 Dim i As Integer   '繰り返しの制御変数
 Dim j As Integer   '繰り返しの制御変数
 Dim cnt As Integer '判断のアシスト変数

'----------------
'判断
'----------------
 cnt = 0
 
 For i = 1 To UBound(kou, 1)
    For j = 1 To UBound(kou, 2)
        If kou(i, j).La <> "" Then
            cnt = cnt + 1
            stock = stock + kou(i, j).Va * (-1) ^ i
        End If
    Next
 Next
 
 'If cnt = 0 Or cnt = UBound(kou, 1) * UBound(kou, 2) Then
 If cnt <> UBound(kou, 2) Then
    Equ_ReDo_Jdg = True
 End If
 
 If stock = 0 Then

    Equ_ReDo_Jdg = True
 End If
End Function

今回は「文字を持つ項が全体の半分」であり「方程式を整理しても文字を持つ項が残る」ことを条件としています。

まとめ

全体的にまだしっくりとは来ていないのですが、これをたたき台として作っていきます。

次回は「解析関数」を作りましょう。

計算プリント 第一回統合 その3 (数値指定系)

はじめに

「数値指定系」は最初に作った関数たちです。
二項の計算に絞って「意図的な計算式」を作るものです。

これは「二項の関係」が肝なので「無作為系」や「繰り返し系」とは相いれません。
これはこれで出来るだけ小さくまとめます。

統合してみる

まずは「分数の計算」を現状での最新式に書き換えます。
そして「整数の計算」をそれに対応させます。

Formula_Make_C

Cは二項の値を同時に(?)決める仕様です。

Function Formula_Make_C(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    '計算式の答え
 
'------------------
'kou,opeを指定
'------------------
 ReDim kou(1 To 2)
 ReDim ope(1 To 2)
 
 ope(1) = "-"
 ope(2) = ""
 kou = Fra_Num_Select(ope(1))
 
'------------------
'str1を作成
'------------------
 str1 = Lit_Str_Make(kou, ope)
 
'------------------
'ansを配列で取得
'------------------
 ans = Lit_Str_Analyze(str1)
 
'------------------
'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_C = str
End Function

Fra_Num_Select

Literal2クラスに対応させました。
また、Formula_Make_Cのほうで出来ることはそちらでさせる方針に。

Function Fra_Num_Select(ope) As Literal2()
'------------------------
'変数の定義
'------------------------
 Dim kou(1 To 2) As Literal2    '分数
 Dim swt As Literal2
 Dim tmp As Integer
 
'------------------------
'kouの値を仮決め
'------------------------
 Set kou(1) = New Literal2
 Set kou(2) = New Literal2
 
 kou(1).Va = Rnd_Num(1, 3)
 kou(1).Vb = Rnd_Num(3, 8)
 kou(2).Va = Rnd_Num(1, 3)
 kou(2).Vb = Rnd_Num(1, 3) * kou(1).Vb
 
 
'-------------------------
'versionを反映してkou1,2を本決定
'-------------------------

 Select Case ope
    Case Is = "+"
    
    Case Is = "-"
        If kou(1).Va * kou(2).Vb - kou(1).Vb * kou(2).Va < 0 Then
            Set swt = kou(1)
            Set kou(1) = kou(2)
            Set kou(2) = swt
        End If
        
    Case Is = "×"
        swt = kou(2).Va
        kou(2).Va = kou(2).Vb
        kou(2).Vb = swt
        
    Case Is = "÷"

 End Select
 
 Fra_Num_Select = kou
 
End Function

Int_Num_Select

「整数の計算」の関数たち、中でも「Num_Select」系はコードの分量が多くて、うまくまとめるのが難しいです。
なので今回はごまかしの方法で。
従来の関数で数値を指定してから、それをそのままLiteral2クラスの変数に変換することにしました。

Function Int_Num_Select(ope, level) As Literal2()
'----------------------------------
'LitとIntのパイプ
'kouを指定する
'----------------------------------

'----------------------------------
'扱う変数の定義
'----------------------------------
 Dim kou() As Literal2
 Dim num() As Integer   '指定する数値
 Dim ans As String      'strに戻す値
 Dim tmp As Integer     'numを入れ替えるための変数
 
'----------------------------------
'numの値の決定
'----------------------------------
 Select Case ope
    Case Is = "+", "-"
        num() = Int_AddSub_Num_Select(level)
    Case Is = "×", "÷"
        num() = Int_MulDiv_Num_Select(level)
 End Select
 
'----------------------------------
'引き算、割り算用の処理
'----------------------------------
 Select Case ope
    Case Is = "+", "×"
    Case Is = "-", "÷"
        tmp = num(1)
        num(1) = num(3)
        num(3) = tmp
 End Select
 
'----------------------------------
'kouを作成
'----------------------------------
 ReDim kou(1 To 2)
 
 For i = 1 To 2
    Set kou(i) = New Literal2
    Call kou(i).Conversion(num(i))
 Next

 Int_Num_Select = kou
End Function

意外と悪くない考え方なんじゃないかなと思います。

まとめ

なんだかものすごい疲れました。
なんていうんだろう。
頭の変な部分を使った気がします。

楽しいというより苦しい回でしたが、第一回統合もこれで終わり。

次に何をするかはやっぱり悩ましいですね。

「文章問題」と「方程式」が天秤に乗っています。

んー。

指で右に傾けて、「方程式」に進みましょう。

計算プリント 第一回統合 その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系の関数をいくつか減らしました。

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