[[20160823181717]]　『ケース文を使った条件分岐で定義文に混乱をおこし』（snb1001）　ページの最後に飛ぶ

『ケース文を使った条件分岐で定義文に混乱をおこしてます。』（snb1001）

 A列 B列 C列 D列 E列       J列
1 　　　 和  差  積  ・・・
2 13 25  
3 51 22 
4 ・ ・
5 ・ ・

上記のような表があり、空欄にそれぞれ答えを入れる式をVBAを使って
入れたいと思っています。
例えばC2には38、D2には-12、E2には325が入るようにしたいと思っています。

１、一種の練習なのでケース文を使って書きたいです。
２、ここでは左上にいつもA1がありますが、これをエクセルの
中央部分に表がある場合でも走るようにしたいです。
３、OFFSETを使ってみたい。
４、ActiveCellを使ってみたい。空欄にカーソルを持っていけば
そこの位置を基準に左に計算対象の二つのセル、また上に一つのところを見れば
ケースわけの「条件」としての「和」「差」「積」「商」・・・
が手に入るので

OFFSET(ActiveCell.Address,0,-2)・・・A列を指す場合
OFFSET(ActiveCell.Address,0,-1)・・・B列を指す場合
OFFSET(ActiveCell.Address,-1,0)・・・C1を指す場合

これは順番に変数s、t、rのつもりですが、
これを具体的にどう「Sub」の中に組み込んで
いけばよいのか自信がないです。

やりたいことの雰囲気は下記のようなVBAです。

Sub SelectCaseを使った条件分岐()

    Dim s As String
　　Dim t As String
　　Dim r As String

　 If Case r= "和":

        Active.Formula = "=" & OFFSET(ActiveCell.Address,0,-2) & "+" & OFFSET(ActiveCell.Address,0,-1)

    Case ｒ＝ "差”：
        Active.Formula = "=" & OFFSET(ActiveCell.Address,0,-2) & "-" & OFFSET(ActiveCell.Address,0,-1)

    Case ｒ＝ "積”：
        Active.Formula = "=" & OFFSET(ActiveCell.Address,0,-2) & "*" & OFFSET(ActiveCell.Address,0,-1)

    End If

  End Sub

＜使用 Excel：Excel2010、使用 OS：Windows7 ＞

 表が左上隅にあった場合の A1 にあたる位置を選択して実行。
 数値が計算に不適切かどうかのチェックはしていません。

 Sub Sample()
    Dim rY As Range
    Dim rX As Range
    Dim r As Range
    Dim a As Range
    Dim c As Range
    Dim n1 As Long
    Dim n2 As Long
    Dim s As String

    Set rY = ActiveCell.EntireColumn.Cells(Rows.Count).End(xlUp)
    Set rX = ActiveCell.EntireRow.Cells(Columns.Count).End(xlToLeft)
    Set r = Range(rY, rX)
    For Each a In r.Resize(r.Rows.Count - 1).Offset(1).Rows
        For Each c In a.Resize(, a.Cells.Count - 2).Offset(, 2).Cells
            s = Intersect(c.EntireColumn, r.Rows(1)).Value
            n1 = Intersect(c.EntireRow, r.Columns(1)).Value
            n2 = Intersect(c.EntireRow, r.Columns(2)).Value

            Select Case s
                Case "和"
                    c.Value = n1 + n2
                Case "差"
                    c.Value = n1 - n2
                Case "積"
                    c.Value = n1 * n2
                Case Else
                    c.ClearContents
            End Select

        Next
    Next

 End Sub

（β） 2016/08/23(火) 21:01

 >Active.Formula = "=" & OFFSET(ActiveCell.Address,0,-2) & "+" & OFFSET(ActiveCell.Address,0,-1)
                           ↑
　　　　　　この　OFFSET　は、エクセル関数ですよね。
　　　　　　VBAのコードじゃないんだから、文字列として組み込まないとだめです。

 例
 = "=OFFSET(" & ActiveCell.Address & ",0,-2)"
 BJ 0:15

 領域に式を埋め込むなら、もう少しシンプルになります。

 Sub Sample2()
    Dim rY As Range
    Dim rX As Range
    Dim r As Range
    Dim col As Range
    Dim n1 As Long
    Dim n2 As Long

    n1 = ActiveCell.Column
    n2 = n1 + 1

    Set rY = ActiveCell.EntireColumn.Cells(Rows.Count).End(xlUp).Offset(, 2)
    Set rX = ActiveCell.EntireRow.Cells(Columns.Count).End(xlToLeft).Offset(1)
    Set r = Range(rY, rX)

    For Each col In r.Columns

        Select Case col.Offset(-1).Resize(1).Value
            Case "和"
                col.FormulaR1C1 = "=RC" & n1 & "+RC" & n2
            Case "差"
                col.FormulaR1C1 = "=RC" & n1 & "-RC" & n2
            Case "積"
                col.FormulaR1C1 = "=RC" & n1 & "*RC" & n2
            Case Else
                col.ClearContents
        End Select

    Next

 End Sub

 なお、A1に当たる場所を選択した上で実行という運用は、選択間違いなどのリスクもありますね。
 A1 に当たる場所に、シート内でユニークな文字列をセットしておいて、その文字列を Findメソッドで検索して
 領域を判断するほうが安全かと思います。

（β） 2016/08/24(水) 08:15

 和、差、積　の判定処理を１つにまとめた書き方もできます。

 Sub Sample3()
    Dim rY As Range
    Dim rX As Range
    Dim r As Range
    Dim col As Range
    Dim n1 As Long
    Dim n2 As Long
    Dim op As String
    Dim s As String

    n1 = ActiveCell.Column
    n2 = n1 + 1

    Set rY = ActiveCell.EntireColumn.Cells(Rows.Count).End(xlUp).Offset(, 2)
    Set rX = ActiveCell.EntireRow.Cells(Columns.Count).End(xlToLeft).Offset(1)
    Set r = Range(rY, rX)

    For Each col In r.Columns
        s = col.Offset(-1).Resize(1).Value
        Select Case s
            Case "和", "差", "積"
                op = Array("+", "-", "*")(WorksheetFunction.Match(s, Array("和", "差", "積"), 0) - 1)
                col.FormulaR1C1 = "=RC" & n1 & op & "RC" & n2
            Case Else
                col.ClearContents
        End Select

    Next

 End Sub

（β） 2016/08/24(水) 08:30

その後も、追加コメントいただいていたのですね。
ありがとうございます。

一つづつ解読を続行しているところです。
おかげで「F1」ヘルプを読んでいても
意味が通じるようになってきました。

（snb1001） 2016/08/24(水) 12:12

 教えていただいたマクロをもとに今度は次のような表に挑戦しています。

          A列　　　B       C       D       E       F       G       H
1	16-09	16-09	16-09	16-09	16-09	16-09	16-09
2 オプション	C/買	C/売	P/買	P/売	先/買	先/売	合成
3 行使価格	1750	1800	1750	1775	1750	1750	
4 プレミアム	30	60	25	15	0	0	
5	16-09C/買1750@30（上の４つのセル内の文字をつないだものプレミアムの前に@を入れた）
6 1700							
7 1712.5							
8 1725							
9 1737.5							
10 1750							
11 1762.5							
12 1775							
13 1787.5							
14 1800							
15 1812.5

やりたいこと　
1　6行目以降を次の式をもとに埋めたい。H列はB:Gの和である。

            Case "C/買"
                col.Formula '=MAX(A6-$B$3,0)-$B$4
            Case "C/売"
                col.Formula '=-MAX(A6-$C$3,0)+$C$4
            Case "P/買"
                col.Formula '=-MIN(A6-$D$3,0)-$D$4
             Case "P/売"
                col.Formula '=MIN(A6-$E$3,0)+$E$4
            Case "先物買"
                col.Formula '=A6-$F$3-$F$4
            Case "先物売"
                col.Formula '=-A6+$G$3+$G$4

            Case Else
                col.ClearContents

2　A5からH15までの範囲のグラフを描きたい。12.5づつ動くことは変わらないが中心の数字は日経平均くらい。例では幅を上下に50くらいの幅にしているがここの上下幅は150くらいになることもある。つまり1600から1900くらい。

◎自分で挑戦してどうしても越えられなかったところ。
Sub Sample2()の

    n1 = ActiveCell.Column
    n2 = n1 + 1

これは列が同じ行で二つ並んでいるから「＋１」としているので
もし行が同じ行ではなく、違っていたら何処をどう変えればいいのかがどうしてもわからなかったです。

（snb1001） 2016/08/30(火) 09:14

グラフについてです。
グラフは「散布図」「平滑線とマーカー」で
横軸は日経の上下幅です。

（snb1001） 2016/08/30(火) 09:22

 本件、新しいテーマですし、グラフも絡んで切るようですので、新しいトピとして立ち上げられてはいかがでしょう。

 今のままでは、旧トピの継続のような印象で、皆さん、閲覧されても、あぁ　βが手掛けている案件だからと
 スルーされる可能性もあります。

 新しいトピにして、あらためて、レイアウトや要件、あるいは、現在できているコードをアップして
 幅広く皆さんに質問したほうが、有益な回答が早く寄せられると思います。

 （特に、βは　グラフがからっきし、NGなので、その部分、お手伝いできそうにありませんし）

（β） 2016/08/30(火) 13:52

アドバイス、ありがとうございます。
了解いたしました。
（snb1001） 2016/08/30(火) 17:13

コメント返信：

[ 一覧(最新更新順) ]

[[20160823181717]] 『ケース文を使った条件分岐で定義文に混乱をおこし』（snb1001） ページの最後に飛ぶ

[[20160823181717]]　『ケース文を使った条件分岐で定義文に混乱をおこし』（snb1001）　ページの最後に飛ぶ