指定したセル範囲に、別の指定セルの値を使って計算した値を表示させたい

下記エクセルシートの黄色のセル範囲にM列以降1行目の日付に応じた計算式の結果を入れたいと考えています(excelは2010です)。

初めVBAを使わずにワークシート関数のIF文の入れ子で表示させていましたが、複雑になりすぎた上、実際の範囲がかなり広くエクセルが重くて開くのさえ難しくなってしまったため、VBAで計算した結果だけを表示させようとしています。

VBAで書いたコードは以下の通りです。

Sub calc()
    Dim c, rng
    
    Set rng = Worksheets(1).Range("M2:AJ4")
    
    For Each c In rng
        Select Case Worksheets(1).Range("M1")
            Case Is < Worksheets(1).Range("$B2")
                c.Value = 0
            Case Is <= Worksheets(1).Range("$C2")
                c.Value = Worksheets(1).Range("$G2") * Worksheets(1).Range("$A2")
            Case Is <= Worksheets(1).Range("$D2")
                c.Value = Worksheets(1).Range("$H2") * Worksheets(1).Range("$A2")
            Case Is <= Worksheets(1).Range("$E2")
                c.Value = Worksheets(1).Range("$I2") * Worksheets(1).Range("$A2")
            Case Is <= Worksheets(1).Range("$F2")
                c.Value = Worksheets(1).Range("$J2") * Worksheets(1).Range("$A2")
            Case Else
                c.vlaue = 0
        End Select
    Next
End Sub

M列以降1行目の応当日が、B列日付未満であれば0を、B列日付以上C列日付未満であればG列とA列を乗じた値をと算出させて、値のみを表示させたいと考えていますが、ワークシート関数のような相対参照がうまくできず、すべて同じ値になってしまいます(この場合すべて130)。

どのようにしたらうまくセルごとに参照箇所を変えるようなコードになるのでしょうか。

よろしくお願いいたします。

行動規範の内容に同意します

回答3件

ベストアンサー

cOffで年度が増えた際に可変対応できます。コピーペで使ってみてください。

Sub calc()
    With ThisWorkbook.Worksheets(1)
        cOff = 5
        Set Rng = .Range("M2:Z4")
        For Each R In Rng.Rows
            K = .Cells(R.Row, 1).Value
            For Each C In R.Cells
                For i = 2 To cOff + 1
                    If .Cells(C.Row, i).Value >= .Cells(1, C.Column).Value Then
                        C.Value = .Cells(C.Row, i + cOff) * K
                        If i = 2 Then C.Value = 0
                        Exit For
                    End If
                Next i
            Next
        Next
        Set Rng = Nothing
    End With
End Sub

投稿2018/08/28 05:40

paolo.ahn

総合スコア73

jun.k

2018/08/29 04:42

ありがとうございます。まさにやりたかった結果です。　なかなか思いつきませんでしたが非常に参考になりました。引き続きよろしくお願いいたします。

paolo.ahn

2018/08/29 06:37

昨日登録したばかりの勢いで、試すことができて良かったです。こちらこそ、宜しくお願い致します。

行動規範の内容に同意します

コードが見にくいと、理解しにくくなり、バグに気付きにくくなってしまいます。

また、オブジェクトは変数の型を正しく設定すると、
.を入力して Ctrl＋Space で候補が出てくれるので、
入力ミスが無くなります。

参考までに例を。

VBA
1Sub calc()
2    
3    Dim sht As Worksheet
4    Set sht = ThisWorkbook.Worksheets(1)
5    With sht
6        
7        Dim rng As Range
8        Set rng = .Range("M2:AJ4")
9        
10        Dim c   As Range
11        For Each c In rng
12            Select Case .Range("M1")
13                Case Is < .Range("$B2"):    c.Value = 0
14                Case Is <= .Range("$C2"):   c.Value = .Range("$G2") * .Range("$A2")
15                Case Is <= .Range("$D2"):   c.Value = .Range("$H2") * .Range("$A2")
16                Case Is <= .Range("$E2"):   c.Value = .Range("$I2") * .Range("$A2")
17                Case Is <= .Range("$F2"):   c.Value = .Range("$J2") * .Range("$A2")
18                Case Else:                  c.vlaue = 0
19            End Select
20        Next
21        
22    End With
23    
24End Sub

投稿2018/08/27 04:05

ExcelVBAer

総合スコア1175

jun.k

2018/08/27 04:49

ありがとうございます。見やすくなりました。これで再度考えてみます。

ExcelVBAer

2018/08/27 05:26

また、デバッグしたい時は、ステップ実行(Ｆ８)等の操作、イミディエイトウィンドウ、ローカルウィンドウの使い方を覚えると、プログラムの修正が格段に楽になります。

jun.k

2018/08/27 08:04

わかりました。ありがとうございました。

行動規範の内容に同意します

理由はの１点目として範囲の片側しか判定されていないからです。
以下のように記述する必要があります。

VBA
1        Select Case True
2            Case Worksheets(1).Range("M1") < Worksheets(1).Range("$B2")
3                c.Value = 0
4            Case Worksheets(1).Range("M1") >= Worksheets(1).Range("$B2") And Worksheets(1).Range("M1") < Worksheets(1).Range("$C2")
5                c.Value = Worksheets(1).Range("$G2") * Worksheets(1).Range("$A2")
6
7        End Select

後は起点となる部分をずらしていない（上記だとM1)から。

ただ、軽くするだけの理由なら以下のような式だと軽減されませんか？

Excel
1=((M$1>=$B2)*(M$1<$C2)*$G2+(M$1>=$C2)*(M$1<$D2)*$H2+(M$1>=$D2)*(M$1<$E2)*$I2+(M$1>=$E2)*(M$1<$F2)*$J2+(M$1>=$F2)*$K2)*$A2

※上記をM2に張り付けてコピーして、他のセルに張り付け
但し、例示の書式だとどちらかに寄せるしかないので、上記は開始を起点として片側のみの判断となっています。
※VBAでも同じだと思いますが。

投稿2018/08/26 16:23

編集2018/08/26 16:37

sazi

総合スコア25195

jun.k

2018/08/27 03:39

ありがとうございます。　範囲の指定の仕方、よく分かりました。実は対象セルは他のシートにもございまして、1行目の日付も一日毎数年分あります。また条件式自体もこれよりもっと複雑になっておりまして、ワークシート関数だとどうしても重くなるのでVBAで値だけ表示させたいと思っております。またご指摘の通り、起点となる点をずらしていないと思いますが、上記の通り対象セルが膨大にあるため、これをFor eachで回すときに自動でずらせないかを検討してます。VBAコード上で"M$1"としてもだめでした。　意図している動きとしては、例えばN2のセルの時はM1ではなくN2を参照するようにしたり、O3セルの時はO1セルとB～F列の3行目を比較して判定し、合致する3行目の値とA3セルを乗じる、などです。ワークシート関数だと$を列番号か行番号の前につけたりはずしたりして調整して、別のセルへコピーすれば自動で参照するように行番号列番号が変わると思いますが、VBAではどう表現すべきか悩んでおります。

sazi

2018/08/27 04:37

>ワークシート関数だとどうしても重くなるので提示した例では、ワークシート関数は一切使用していませんよ。それでも重かったということでしょうか？

jun.k

2018/08/27 08:10

そういえばそうですね。失礼致しました。　実際の式はこれより複雑になってしまう(IF文のネストで対応しているのですが、一つのセルに10コネストしています)ので、頂いた例を元にどのように修正できるか考えてみます!!。有難うございました。

sazi

2018/08/27 08:23

条件がANDなら同様の展開で可能ですが、or条件の場合は１つであれば*(論理積)の部分を+(論理和)に変更すればOKですけど、2つ以上のORだと括って>1の判定にする必要があります。重くないなら、非表示のセルに式を分割しておいて可読性を高めるのも方法の一つかと思います。

sazi

2018/08/27 08:33

>For eachで回すときに自動でずらせないかを検討してます。VBAコード上で"M$1"としてもだめでした。　 A1参照方式ではなくR1C1参照方式で、指定すれば良いですよ。

jun.k

2018/08/27 08:49

ありがとうございます!!。やってみます。

jun.k

2018/08/27 09:54

R1C1参照方式でコードを書く際に、列のみ絶対参照にするにはCells(1,"A")で良いのだとおもいますが、行のみ絶対参照にするにはどうすればよいのかお分かりになりますでしょうか。ネットで調べてみたのですが合致したものが今のところ見つかりませんでした。

ExcelVBAer

2018/08/28 00:06

絶対参照、相対参照の理解不足ですね。 A1、1,A 、1,1 いずれも固定で指定してたら変わるはずもないですよね？相対参照で使われるパターンは以下の２点でしょう。１：Offset → Range().Offset([行方向に移動],[列方向に移動]) ２：Cells → Cells(1+[行方向に移動], 1+[列方向に移動]) 列に「A」等を使いたいのであれば、１、列も「１」等と番号を使うのなら、２、で処理毎に位置を調整して処理できるでしょう。

jun.k

2018/08/29 04:39

ありがとうございました。ワークシート関数を使わない式で軽くする方法等ご教示頂きまして大変参考になりました。上記理解不足の点反省致します。質問自体は他の方の回答で解決致しました。こちらの説明不足で意図が伝わらず大変申し訳ありませんでしたが、引き続きよろしくお願いいたします。

行動規範の内容に同意します

あなたの回答