掛け算と割り算の式を分解してリスト化するExcelVBA

とんでもなく需要は少ない気がするのですが、せっかく組んだのでメモがてら。意外とどこかで誰かの役に立つかもしれないし！

目的

わたしは製造業勤務でして、現場の方からこういう要望があったのです。

「こっちの表ではひとつのセルに総数を出しておいて、他のセルとSUM関数とかで計算できるようにしておきたいんだけど、出荷表に転記するときに出荷時の袋数で出るようにしたい」と。

ひとつの袋に入っている数が同じなら、指定の数で割った商と余りを出せばいいので難しくないんですが、違うこともあるみたいなんですよね。で、頭を捻ってこんな感じにしてみました。

入数×袋数の数式を使って書いてもらっておいて、その数式を分解して、違う場所（この図なら、C～Eのセル）へリスト化する、と。

いろいろと面倒なので、入力のほうで「*」と「+」以外は使わないようにしてもらっています。かっことかもなくても大丈夫とのことなので。使えない文字が含まれている場合はエラーが出るようにしておきます。

コード

Private f1 As String, n As Integer

Sub 数式分解()
  Dim f2 As String, m As Integer

  If Range("A1") = "" Then Exit Sub '何もなければ終了
  Range("C1:E10").ClearContents

  f1 = Range("A1").Formula '数式を取得
  f1 = Replace(f1, "=", "") 'イコールを消す

  Call エラー処理

  f2 = "" 'リセット
  n = 1 '書き込み行数用

  Do '数式を分解しながらループ
    If IsNumeric(f1) = True Then
      Call 数値だけ
      Exit Do
    End If

    m = InStr(f1, "+")
    If m = 0 Then '+がなかったら
      Call 掛け算
      Exit Do
    Else '+があったら
      f2 = Right(f1, Len(f1) - m) '「+」より右側だけ取得
      f1 = Left(f1, m - 1) '「+」より左側だけ取得
      If IsNumeric(f1) = True Then
        Call 数値だけ
        f1 = f2
        f2 = ""
      Else
        Call 掛け算
        f1 = f2
        f2 = ""
      End If
    End If

    n = n + 1 '書き込み行数用
  Loop

End Sub

Sub エラー処理()
  Dim f2 As String

  f2 = Replace(f1, "+", "")
  f2 = Replace(f2, "*", "")
  If IsNumeric(f2) = False Then '+、*以外の式が使われていたらNG
    MsgBox "+と*以外が含まれる式は処理できません。"
    End
  End If
End Sub

Sub 数値だけ()
  Cells(n, 3) = f1
  Cells(n, 4) = "×"
  Cells(n, 5) = 1
End Sub

Sub 掛け算()
  Dim m As Integer

  m = InStr(f1, "*")
  Cells(n, 3) = Left(f1, m - 1) '「*」より左側
  Cells(n, 4) = "×"
  Cells(n, 5) = Right(f1, Len(f1) - m) '「*」より右側
End Sub

A1に入っている数式を分解してC~E列に出力します。下3つのプロシージャは呼び出し用なので、起動は「数式分解」のプロシージャです。モジュール内で跨いで使う変数はPrivate宣言しています。

解説

それなりに長いので細かい説明は省いてしまいますが、IsNumericを使って数式が含まれているか判断しながら、InStrで「+」または「*」の位置を特定して、その左側と右側をそれぞれ取り出してごにょごにょしていくって感じです。実際に走らせてF8で1行ずつ確認していくと動きが分かりやすいと思います。

以上です。出荷関係のお仕事の方の参考になれたら幸いですw