[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『一つのセルの中の計算式の答えを別のセルに表示する』（山海猿）
A B C D E 1 a×b+(c+d) ＝ Ans
上記のようなときA1に算式を表示させておきE1に答えを表示させる場合にE1にどのように入力すると自動計算してくれるのですか？
たくさん過去ログがありますよ。 （純丸）(o^-')b [[20051027235051]] 『A1のセルに式をB1のセルに答えを…』(のなか) [[20051006180417]] 『文字列を計算式へ』(box) [[20050211090552]] 『計算式の表示と答えの表示』(やす) [[20040920110048]] 『マクロを使わずに関数だけで』(うーん) [[20040707170516]] 『計算結果を隣のセルに表す方法は?』(たろ) [[20040131111956]] 『セル内の和』(mutsu) [[20031224165448]] 『計算結果を別のセルに表示する』(toshi)
例えば{５＋１０÷（４＋１）}÷２ 等という式でもやっつけてしまう関数！
標準モジュールにコピペ
=newcalc(a1)といった塩梅に入力
昔どっかで拾うた関数ですけど、ルートの計算が上手い事いかんみたい（笑
余力のある方は完成させてくらはい。
（弥太郎）
'-------------------------------- Option Explicit
Private str_data As String Private str_dataType As Integer '1:hugou 2:num 3:function Private st As String Private stLen As Integer Private GP As Integer Private kacco As Integer Const hugou As String = "+-*/()^" Const num As String = "0123456789" Const rad As Double = 57.2957795130823 '------------------------------------- Function Newcalc(data As String) As Double
data = StrConv(data, vbNarrow)
data = StrConv(data, vbLowerCase)
data = Replace(data, " ", "")
data = Replace(data, "×", "*")
data = Replace(data, "÷", "/")
data = Replace(data, "=", "")
data = Replace(data, "√", "sqrt")
data = Replace(data, ",", "")
data = Replace(data, "{", "(")
data = Replace(data, "}", ")")
data = Replace(data, "[", "(")
data = Replace(data, "]", ")")
data = Replace(data, "π", "3.14159265358979")
data = Replace(data, "pi", "3.14159265358979")
data = Replace(data, "rad", "57.2957795130823")
kacco = 0
GP = 1
st = data
stLen = Len(st)
Getstr_data
Newcalc = sub1(0#)
If (kacco <> 0) Then
MsgBox "カッコの指定に誤りがあります。" _
, vbOKOnly + vbExclamation, "Newcalc"
Newcalc = 1 / 0
End If
End Function
'----------------------------------------
Function sub1(Value As Double) As Double ' 加算・減算の処理
Dim Value2 As Double
Dim str_data2 As String
Value = sub2(Value)
While str_data = "+" Or str_data = "-"
str_data2 = str_data
Getstr_data
Value2 = sub2(Value2)
Select Case str_data2
Case "+"
Value = Value + Value2
Case "-"
Value = Value - Value2
End Select
Wend
sub1 = Value
End Function
'-----------------------------------
Function sub2(Value As Double) As Double ' 乗算、除算の処理
Dim Value2 As Double
Dim str_data2 As String
Value = sub3(Value)
While str_data = "*" Or str_data = "/"
str_data2 = str_data
Getstr_data
Value2 = sub3(Value2)
Select Case str_data2
Case "*"
Value = Value * Value2
Case "/"
Value = Value / Value2
End Select
Wend
sub2 = Value
End Function
'------------------------------------
Function sub3(Value As Double) As Double ' べき乗の処理
Dim Value2 As Double
Dim str_data2 As String
Value = sub4(Value)
While str_data = "^"
str_data2 = str_data
Getstr_data
Value2 = sub4(Value2)
Select Case str_data2
Case "^"
Value = Value ^ Value2
End Select
Wend
sub3 = Value
End Function
'---------------------------------
Function sub4(Value As Double) As Double ' 単項演算子の処理
Dim str_data2 As String
If str_data = "+" Or str_data = "-" Then
str_data2 = str_data
Getstr_data
End If
Value = sub5(Value)
If str_data2 = "-" Then
Value = -Value
End If
sub4 = Value
End Function
'--------------------------------
Function sub5(Value As Double) As Double ' カッコの処理
If str_data = "(" Then
Getstr_data
Value = sub1(Value)
Getstr_data
Else
Value = Atom()
End If
sub5 = Value
End Function
'-------------------------------
Function Atom() As Double ' 数値の処理
Dim temp As String
Dim i As Integer
Dim Value2 As Double
If str_dataType = 3 Then
Atom = Func(str_data)
ElseIf str_dataType = 2 Then
Atom = Val(str_data)
Getstr_data
End If
End Function '---------------------------------- Function Func(str As String) As Double '算術関数の処理
Dim Value2 As Double
Dim str2 As Double
Select Case str
Case "sin"
Getstr_data
Value2 = sub4(Value2)
Func = Sin(Value2 / rad)
Case "cos"
Getstr_data
Value2 = sub4(Value2)
Func = Cos(Value2 / rad)
Case "tan"
Getstr_data
Value2 = sub4(Value2)
Func = Tan(Value2 / rad)
Case "asin"
Getstr_data
Value2 = sub4(Value2)
Func = WorksheetFunction.Asin(Value2) * rad
Case "acos"
Getstr_data
Value2 = sub4(Value2)
Func = WorksheetFunction.Acos(Value2) * rad
Case "atan"
Getstr_data
Value2 = sub4(Value2)
Func = Atn(Value2) * rad
Case "abs"
Getstr_data
Value2 = sub4(Value2)
Func = Abs(Value2)
Case "int"
Getstr_data
Value2 = sub4(Value2)
Func = Int(Value2)
Case "exp"
Getstr_data
Value2 = sub4(Value2)
Func = Exp(Value2)
Case "log"
Getstr_data
Value2 = sub4(Value2)
Func = Log(Value2)
Case "sqrt"
Getstr_data
Value2 = sub4(Value2)
Func = Sqr(Value2)
Case Else
MsgBox "関数 " + str + " は定義されていません." _
, vbOKOnly + vbExclamation, "Newcalc"
Func = 1 / 0
End Select
End Function '-------------------------------- Function Getstr_data()
Dim i As Integer
If GP > stLen Then
str_data = ""
Exit Function
End If
If InStr(hugou, Mid(st, GP, 1)) <> 0 Then
str_data = Mid(st, GP, 1)
str_dataType = 1
GP = GP + 1
If str_data = "(" Then '括弧のチェック
kacco = kacco + 1
ElseIf str_data = ")" Then
kacco = kacco - 1
End If
ElseIf InStr(num, Mid(st, GP, 1)) <> 0 Then
For i = GP To stLen
If InStr(hugou, Mid(st, i, 1)) <> 0 Then
Exit For
End If
Next
str_data = Mid(st, GP, i - GP)
str_dataType = 2
GP = i
Else
For i = GP To stLen
If InStr(hugou, Mid(st, i, 1)) <> 0 Then
Exit For
End If
Next
str_data = Mid(st, GP, i - GP)
str_dataType = 3
GP = i
End If
End Function
皆さんありがとうございました。初心者なので大変助かりました。またご教授お願いします。 （山海猿）
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.