| |
▼はじめてのVBA さん：
はじめまして。
厳密に考えると、もっともっと条件が沢山ありそうですが・・・
とりあえず叩き台として
Private Sub Worksheet_Change(ByVal Target As Range)
Dim myFml As String
Dim myPlc As Integer
Dim Ans As Double
If Not Application.Intersect(Target, Me.Range("A3:B30")) Is Nothing Then
With Target.EntireRow
myFml = .Cells(1).Value
myPlc = .Cells(2).Value
Ans = Application.Evaluate(myFml)
Application.EnableEvents = False
If IsError(Ans) Then
.Cells(3).Value = "数式を確認"
.Cells(4).Value = "Err"
Else
RepFormula .Cells(3), myFml
.Cells(4).NumberFormatLocal = IIf(myPlc = 0, "0", "0." & String(myPlc, "0"))
.Cells(4).Value = Ans
End If
Application.EnableEvents = True
End With
End If
End Sub
Private Sub RepFormula(myRng As Range, myStr As String)
Dim myReg As Object
Dim i As Long
myStr = StrConv(myStr, vbLowerCase)
myStr = Replace(myStr, "+", "＋")
myStr = Replace(myStr, "-", "−")
myStr = Replace(myStr, "*", "×")
myStr = Replace(myStr, "/", "÷")
myStr = Replace(myStr, "pi()", "π")
myStr = Replace(myStr, "sqrt", "√")
With CreateObject("VBScript.RegExp")
.Global = True
.Pattern = "\^-*\d+"
Set myReg = .Execute(myStr)
myStr = Replace(myStr, "^", "")
myRng.Value = myStr
For i = 1 To myReg.Count
With myReg.Item(i - 1)
myRng.Characters(.firstindex + 2 - i, .Length - 1).Font.Superscript = True
End With
Next i
End With
End Sub
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
