| |
皆さん、こんにちは。
>Select Case の使い方はJakaさんの御回答を参考に＾＾
CASE文のご質問なのでこれはこれで・・・。
>私のは質問の内容とはまったく違うのですが
>今回のような計算の場合、数学的にもっと簡単に
>１つの計算式の中で値の条件分岐で求められると思ったので
私もこの事象だとたぶん、Case文は使わないことが多いです。
理由は、拡張性を考慮した場合、Case文を使用すると、コード変更を余儀なくされそうだ
からです。
例えば、ご質問内容だと、三角形、正方形、台形ですが、円を追加したとき
コードの変更が要らないようにしたいということです。
（もしくは、殆ど要らないようにしたい）
新規ブック（Sheet1、Sheet2というシート名が存在するブック）の
標準モジュールに
'==================================================================
Option Explicit
Sub mk_sample()
Application.EnableEvents = False
With Worksheets("sheet2")
.Range("a1:b3").Value = _
[{"三角形","c???*d???/2";"正方形","c???*d???";"台形","(b???+c???)*d???/2"}]
End With
With Worksheets("sheet1")
.Range("a1:e1").Value = Array("形", "上辺", "底辺", "高さ", "面積")
.Range("a2:a4").Value = [{"三角形";"正方形";"台形";" "}]
With .Range("a2:a100").Validation
.Delete
.Add Type:=xlValidateList, _
AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, _
Formula1:="=INDIRECT(""sheet2!a1:a4"")"
End With
End With
Application.EnableEvents = True
End Sub
上記のmk_sampleの実行でサンプルデータをSheet1とSheet2に作成します。
Sheet1には、kumi さんが提示された面積計算表シート
Sheet2には、各多角形名称と面積計算公式が入力されています。
次いでSheet1のシートモジュールに
'============================================================
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rw As Long
Dim arw As Variant
Dim rng As Range
With Target
If .Count <> 1 Then Exit Sub
If .Row > 1 Then
rw = .Row
With Worksheets("sheet2")
Set rng = .Range("a1", .Cells(.Rows.Count, "a").End(xlUp))
End With
arw = Application.Match(Range("a" & rw).Value, rng, 0)
If Not IsError(arw) Then
Application.EnableEvents = False
Range("e" & rw).Value = _
Evaluate(Replace(rng.Cells(arw).Offset(0, 1).Value, "???", rw))
If IsError(Range("e" & rw)) Then Range("e" & rw).Value = ""
Application.EnableEvents = True
End If
End If
End With
End Sub
これで、Sheet1に数値を入力して面積が算出されるか確認してください。
この方法だと、円が追加されても
Sheet2にデータを追加し、入力規則を再設定すれば、
コード変更が殆ど要らないと思います。
「機能追加のため、コード変更を行うとバグの発生確率がｘｘ％増加する」
という話しをはるか昔聞いたことがあります。
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
