VBAで中学数学の問題を扱おう! その1 (単項式)×(単項式)の計算(後半)
とりあえず前回の復習
ケース1: 2×3
ケース2: 2a×3
ケース3: 2b×ac
以上をクリアできるコード
Private Sub CB1_Click()
Dim siki(1) As String '扱う式を代入
Dim answer As String '答え
siki(0) = TB1
siki(1) = TB2
Dim trgt As String '処理用の箱
Dim tmp As Integer '処理用の箱
Dim element(1, 26) As String '数と文字を割り振る
For j = 0 To 1
For i = 1 To Len(siki(j))
trgt = Mid(siki(j), i, 1)
If trgt Like "[a-z]" Then
tmp = Asc(trgt) - 96
element(j, tmp) = element(j, tmp) & trgt
Else
element(j, 0) = element(j, 0) & trgt
End If
Next
Next
'未定義のkazuを1と定義
For i = 0 To 1
If element(i, 0) = "" Then
element(i, 0) = 1
End If
Next
Dim pre As String
For i = 1 To 26
pre = pre & element(0, i) & element(1, i)
Next
answer = Val(element(0, 0)) * Val(element(1, 0))
answer = answer & pre
TB3 = answer
End Sub
- ケース4 ab×ab
現状のコードでは答えが1aabbになってしまいます。
これをどうやってa^2b^2にするか。
a^2b^2って見にくいですが我慢しましょうｗ
いずれ見やすくします。
まずは文字のほうの処理。
この解決策は言われてみれば簡単。
今まではaをaと記録していましたが
これからはaを1と記録すればよい。
a,b,cそれぞれのアルファベットは別の場所に記録される仕組みを取っているのでそれでも不都合は起こりません。
siki(0)とsiki(1)を数値で認識してす。
とりあえずここまでのコードを。
Dim element(1, 26) As Integer '数と文字を割り振る
For j = 0 To 1
For i = 1 To Len(siki(j))
trgt = Mid(siki(j), i, 1)
If trgt Like "[a-z]" Then
tmp = Asc(trgt) - 96
element(j, tmp) = 1
Else
element(j, 0) = element(j, 0) & trgt
End If
Next
Next
それらの数値を処理します。
For i = 1 To 26
tmp = element(0, i) + element(1, i)
If tmp = 1 Then
pre = pre & Chr(96 + i)
ElseIf tmp > 1 Then
pre = pre & Chr(96 + i) & "^" & tmp
End If
Next
これでとりあえず答えが1a^2b^2になります。
この1を消すのが次の問題ですが。
これはもっと簡単。
answer = Val(element(0, 0)) * Val(element(1, 0))
If Abs(Val(answer)) = 1 And pre <> "" Then
answer = Replace(answer, 1, "")
End If
answer = answer & pre
たったこれだけでオッケー。
文字が存在して数値が+1か-1のときには1という表記を消す。
ということです。
コードをまとめます。
Private Sub CB1_Click()
Dim siki(1) As String '扱う式を代入
Dim answer As String '答え
siki(0) = TB1
siki(1) = TB2
Dim trgt As String '処理用の箱
Dim tmp As Integer '処理用の箱
Dim element(1, 26) As Integer '数と文字を割り振る
For j = 0 To 1
For i = 1 To Len(siki(j))
trgt = Mid(siki(j), i, 1)
If trgt Like "[a-z]" Then
tmp = Asc(trgt) - 96
element(j, tmp) = 1
Else
element(j, 0) = element(j, 0) & trgt
End If
Next
Next
'未定義のkazuを1と定義
For i = 0 To 1
If element(i, 0) = 0 Then
element(i, 0) = 1
End If
Next
Dim pre As String
For i = 1 To 26
tmp = element(0, i) + element(1, i)
If tmp = 1 Then
pre = pre & Chr(96 + i)
ElseIf tmp > 1 Then
pre = pre & Chr(96 + i) & "^" & tmp
End If
Next
answer = Val(element(0, 0)) * Val(element(1, 0))
If Abs(Val(answer)) = 1 And pre <> "" Then
answer = Replace(answer, 1, "")
End If
answer = answer & pre
TB3 = answer
End Sub
- ここでいったんコードを整理
ちょっとコードを整えましょう。
書き始めたときには気づかなかったところ
コードを付け足した際に汚くなってしまっているところ
そのあたりをきれいに～
今回は機能的にというよりは見栄えを整える感じです。
まず現状のコードの機能面を書いていきます。
テキストボックスに書かれた式を認識する。
それぞれをの式を一文字ずつ処理する。
element(0,1)やelement(1,1)が未定義の場合は1とする。
文字を処理する。
数字を処理して文字を付け足す。
となっています。
まずは一文字ずつ処理をする。の箇所を直します。
For j = 0 To 1
For i = 1 To Len(siki(j))
trgt = Mid(siki(j), i, 1)
If trgt Like "[a-z]" Then
tmp = Asc(trgt) - 96
element(j, tmp) = 1
Else
element(j, 0) = element(j, 0) & trgt
End If
Next
Next
まずsiki(j)があちこちに書かれている部分がいやですね。
それ以外の文字列を処理したい場合に不都合が出るのでそこを書き直し。
For j = 0 To 1
trgt = siki(j)
For i = 1 To Len(trgt)
char = Mid(trgt, i, 1)
If char Like "[a-z]" Then
tmp = Asc(char) - 96
element(j, tmp) = 1
Else
element(j, 0) = element(j, 0) & Val(char)
End If
Next
Next
続いてはifの部分。
文字かどうかを判別してからAscの関数を使っていますが
これは二度手間です。
Ascの値が一定の領域にあればおのずとそれはa~zのどれかなので。
For j = 0 To 1
trgt = siki(j)
For i = 1 To Len(trgt)
char = Mid(trgt, i, 1)
tmp = Asc(char) - 96
Select Case tmp
Case 1 To 26
element(j, tmp) = 1
Case Else
element(j, 0) = element(j, 0) & Val(char)
End Select
Next
Next
コードが膨らんできたことと
この処理を後のどこかで使うかもしれないことを考慮して
この処理を別のsubプロシージャとして書き直します。
For j = 0 To 1
trgt = siki(j)
Call 文字列を仕分ける(trgt, element)
Next
ーーーーーーーーーーーーー
Sub 文字列を仕分ける(trgt, element)
Dim char As String '処理用の箱
Dim tmp As Integer '処理用の箱
For i = 1 To Len(trgt)
char = Mid(trgt, i, 1)
tmp = Asc(char) - 96
Select Case tmp
Case 1 To 26
element(j, tmp) = 1
Case Else
element(j, 0) = element(j, 0) & Val(char)
End Select
Next
End Sub
これでオッケー。
おそらくですが
このコードは単項式同士の足し算や因数分解に役立つんじゃないかなと思います。
あ。
あとは未定義のelement(0,0)などの処理も「文字列を処理する」プロシージャに入れてしまいましょう。
Sub 文字列を仕分ける(j, trgt, element)
Dim char As String '処理用の箱
Dim tmp As Integer '処理用の箱
For i = 1 To Len(trgt)
char = Mid(trgt, i, 1)
tmp = Asc(char) - 96
Select Case tmp
Case 1 To 26
element(j, tmp) = 1
Case Else
element(j, 0) = element(j, 0) & Val(char)
End Select
Next
If element(j, 0) = 0 Then 'element(j,0)が未定義の場合は1とする
element(j, 0) = 1
End If
End Sub
続いては文字の処理および数字の処理。
これらは変数preとanswerを用いて行っていますが
めちゃくちゃ見栄えが悪いですね。
element(1,26)をelement(2,26)に拡張して
elemetn(0,k)とelement(1,k)の処理結果をelement(2,k)に入れる
それから処理を行うことにします。
文字の処理はこれからもあちこちで使いそうなので
関数化します。
element(2, 0) = Val(element(0, 0)) * Val(element(1, 0))
For i = 1 To 26
element(2, i) = element(0, i) + element(1, i)
Next
answer= line_restoration(element)
ーーーーーーーーーーーーーーーーーー
Function line_restoration(element)
Dim n As Integer
Dim trgt As String
For i = 1 To 26
n = element(2, i)
If n = 1 Then
trgt = trgt & Chr(96 + i)
ElseIf n > 1 Then
trgt = trgt & Chr(96 + i) & "^" & n
End If
Next
If Abs(Val(element(2, 0))) = 1 And trgt <> "" Then
tmp = Replace(element(2, 0), 1, "")
Else
tmp = element(2, 0)
End If
line_restoration = tmp & trgt
End Function
こんな感じです。
はい。
修正したコードを載せます。
Private Sub CB1_Click()
Dim siki(1) As String '扱う式を代入
Dim answer As String '答え
'-------------------------
'式を認識
'-------------------------
siki(0) = TB1
siki(1) = TB2
Dim trgt As String '処理用の箱
Dim tmp As Integer '処理用の箱
Dim element(2, 26) As Integer '数と文字を割り振る
'-------------------------
'一文字ずつ処理
'-------------------------
For j = 0 To 1
trgt = siki(j)
Call 文字列を仕分ける(j, trgt, element)
Next
'-------------------------
'数字と文字の処理
'-------------------------
element(2, 0) = Val(element(0, 0)) * Val(element(1, 0))
For i = 1 To 26
element(2, i) = element(0, i) + element(1, i)
Next
answer = line_restoration(element)
TB3 = answer
End Sub
ーーーーーーーーーーーーーーーーーーーーーー
Sub 文字列を仕分ける(j, trgt, element)
Dim char As String '処理用の箱
Dim tmp As Integer '処理用の箱
For i = 1 To Len(trgt)
char = Mid(trgt, i, 1)
tmp = Asc(char) - 96
Select Case tmp
Case 1 To 26
element(j, tmp) = 1
Case Else
element(j, 0) = element(j, 0) & Val(char)
End Select
Next
If element(j, 0) = 0 Then 'element(j,0)が未定義の場合は1とする
element(j, 0) = 1
End If
End Sub
ーーーーーーーーーーーーーーーーーーーーーー
Function line_restoration(element)
Dim n As Integer
Dim trgt As String
Dim tmp As String
For i = 1 To 26
n = element(2, i)
If n = 1 Then
trgt = trgt & Chr(96 + i)
ElseIf n > 1 Then
trgt = trgt & Chr(96 + i) & "^" & n
End If
Next
If Abs(element(2, 0)) = 1 And trgt <> "" Then '数字が+-1で文字列が存在する場合の処理
tmp = Replace(element(2, 0), 1, "")
Else
tmp = element(2, 0)
End If
line_restoration = tmp & trgt
End Function
これ以上「見やすく」すると「これにしか使えなく」なる気がするので修正はこれくらいに。
ただ数字が+-1で～の処理はちょっときたないですね。。
- ケース4 -a × -a^2
はい。
もう何が起きているんだかって結果ですねｗ
マイナスと累乗は現状のコードでは考慮されていないので
なんか変な風に処理されてこうなっているんですねｗ
これらの処理を担当するのは「文字列を仕分ける」プロシージャなのでそこを修正しましょう。
Sub 文字列を仕分ける(j, trgt, element)
Dim char As String '処理用の箱
Dim tmp As Integer '処理用の箱
For i = 1 To Len(trgt)
char = Mid(trgt, i, 1)
tmp = Asc(char) - 96
Select Case tmp
Case -51
Case -48 To -39
element(j, 0) = element(j, 0) & Val(char)
Case -2
Case 1 To 26
element(j, tmp) = 1
Case Else
MsgBox "考慮されていない文字が入っています"
Stop
End Select
Next
If element(j, 0) = 0 Then 'element(j,0)が未定義の場合は1とする
element(j, 0) = 1
End If
End Sub
これで-と^が認識されます。
そして想定しない文字が出てきた場合はstopする仕様にしました。
後はそれぞれの処理を書くだけ。
現状は文字が出てきたらその文字を担当する箱に1を入れていましたが
累乗を考慮するためにはそうは行かないですね。
数字が出てきたらとりあえずストックする。
-が出てきたら出てきたことを覚えておく。
文字が出てきたら。
ストックが0の場合は1とする。
ストックした数字に場合によっては-1をかけてから箱に入れる
箱を切り替える。
こんな感じにしますか。
Sub 文字列を仕分ける(j, trgt, element)
Dim char As String '処理用の箱
Dim tmp As Integer '処理用の箱
Dim stock As Integer '処理用の箱
Dim reference_number As Integer 'あて先の指定
Dim minus As Integer '-の処理用の箱
minus = 1
reference_number = 0
For i = 1 To Len(trgt)
char = Mid(trgt, i, 1)
tmp = Asc(char) - 96
Select Case tmp
Case -51 '-の場合
minus = -1
Case -48 To -39 '0~9の場合
stock = stock & Val(char)
Case -2 '^の場合
Case 1 To 26 'アルファベットの場合
If stock = 0 Then
stock = 1
End If
element(j, reference_number) = minus * stock
reference_number = tmp
stock = 0
minus = 1
Case Else
MsgBox "考慮されていない文字が入っています"
Stop
End Select
Next
If stock = 0 Then
stock = 1
End If
element(j, reference_number) = minus * stock
End Sub
処理のおかげでelement(k,0)への特別な処理を省くことができました。
いや。
省けたわけではないのですが。
なんていうんだろう。
はみ出た感じが引っ込んだというか。。。
^の文字が出たときにスルーするというやり方、格好良くないですか？ｗ
この処理を思いついたときはテンションがあがりました。
まぁ。
まだそのレベルの人間ということでｗ
やったね。
- 分数の計算
これは結構悩みました。
実はシート上での分数の計算は表記法まで確立させているのですが
ユーザーフォームではどうしようかなーと。。
ただせっかくだし実装はしたいよなーと。。
ほんとにいろいろ考えたのですが。。。
ってしつこいですねｗ
整数の形と分数の形をひとつのユーザーフォームで見栄え良くこなすのは難しいと思ったので。
ユーザーフォームをあと2つ足すことにしました。
選択画面と分数の計算画面です。
分数への解決方法はほんとに何通りもあって
どれを選ぶかはセンスだと思います。
正直に言うと。
複数のユーザーフォームによる処理を書いたことがないのでやってみたくなったという気持ちが大きいのですが。。。
分数の計算の実装の概要を書きます。
分子で文字と数字の処理
分母で文字と数字の処理
約分の処理
表記
基本的には整数のときと同じで
いくつかの配列を分数用に拡張しています。
約分についてだけちょっとだけ。
element(0,k)とelement(1,k)でelement(4,k)を
element(2,k)とelement(3,k)でelement(5,k)を
やり方は整数のときと同じ。
element(4,k)とelement(5,k)でelement(6,k)を
詳しくはコードを読んでください。
element(6,k)にelement(4,k)とelement(5,k)の最大公約数を入れたところがグッドポイントかなと思っていますｗ
あとはpを使ってうまいことやっていますw
Private Sub CB1_Click()
Dim siki(3) As String '扱う式を代入
Dim answer(1) As String '答え
Dim trgt As String '処理用の箱
Dim tmp As Integer '処理用の箱
Dim element(6, 26) As Integer '数と文字を割り振る
'-------------------------
'式を認識
'-------------------------
siki(0) = TB1
siki(1) = TB2
siki(2) = TB4
siki(3) = TB5
'-------------------------
'一文字ずつ処理
'-------------------------
For i = 0 To 3
trgt = siki(i)
Call 文字列を仕分ける(i, trgt, element)
Next
'-------------------------
'数字と文字の処理
'-------------------------
For i = 0 To 1
element(4 + i, 0) = Val(element(2 * i, 0)) * Val(element(2 * i + 1, 0))
For j = 1 To 26
element(4 + i, j) = element(2 * i, j) + element(2 * i + 1, j)
Next
Next
'-------------------------
'約分
'-------------------------
For i = 1 To 26
tmp = element(4, i) - element(5, i)
element(6, i) = tmp
Next
element(6, 0) = WorksheetFunction.Gcd(element(4, 0), element(5, 0))
p = 1
answer(0) = line_restoration(element, p)
p = -1
answer(1) = line_restoration(element, p)
TB3 = answer(0)
TB6 = answer(1)
End Sub
ーーーーーーーーーーーーーーーーーーーー
Sub 文字列を仕分ける(i, trgt, element)
Dim char As String '処理用の箱
Dim tmp As Integer '処理用の箱
Dim stock As Integer '処理用の箱
Dim reference_number As Integer 'あて先の指定
Dim minus As Integer '-の処理用の箱
minus = 1
reference_number = 0
For j = 1 To Len(trgt)
char = Mid(trgt, j, 1)
tmp = Asc(char) - 96
Select Case tmp
Case -51 '-の場合
minus = -1
Case -48 To -39 '0~9の場合
stock = stock & Val(char)
Case -2 '^の場合
Case 1 To 26 'アルファベットの場合
If stock = 0 Then
stock = 1
End If
element(i, reference_number) = minus * stock
reference_number = tmp
stock = 0
minus = 1
Case Else
MsgBox "考慮されていない文字が入っています"
Stop
End Select
Next
If stock = 0 Then
stock = 1
End If
element(i, reference_number) = minus * stock
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーー
Function line_restoration(element, p)
Dim n As Integer
Dim trgt As String
Dim tmp As String
For i = 1 To 26
n = element(6, i) * p
If n = 1 Then
trgt = trgt & Chr(96 + i)
ElseIf n > 1 Then
trgt = trgt & Chr(96 + i) & "^" & n
End If
Next
q = 4.5 - 0.5 * p
If Abs(element(q, 0)) = 1 And trgt <> "" Then '数字が+-1で文字列が存在する場合の処理
tmp = Replace(element(q, 0), 1, "")
Else
tmp = element(q, 0) / element(6, 0)
End If
line_restoration = tmp & trgt
End Function
ふう。
これで(単項式)×(単項式)の計算はクリアです。
根号式やsinやlogには対応していませんがそれはまた別枠ですかね。
プログラミングの面白いところは
(単項式)×(単項式)は簡単だけどlogの計算は難しい
とかはないところですかも。
