第123回目 計算式作成のお手伝い(その２;前回の続き)

第123回目　計算式作成のお手伝い(その２;前回の続き)

　0.最初の処理
　シート名、当該シート番号を取得しておきます。
shname1 = ActiveSheet.Name
ii_max = Sheets.Count　'これはグラフのシートを含む全シートの数です。
ii0 = ActiveSheet.Index　'これは当該シートの番号です。

　1.最初の範囲の取得
　これは定番の処理ですが、ちょっと問題なのは、列行とも複数の指定であった場合、縦に掛けるのか横に掛けるの判断です。正解はないのですが、指定した行数･列数が小さいほうを掛ける方向とします。例えば2行10列を指定していたら、下の方向に掛けていきます。
''範囲情報の取得
AAA = Selection.Address
gyo1 = Selection.Row
gyo_cnt = Selection.Rows.Count
gyo9 = gyo1 + gyo_cnt - 1
retu1 = Selection.Column
retu_cnt = Selection.Columns.Count
retu9 = retu1 + retu_cnt - 1
AAA1 = Cells(gyo1, retu1).Address
AAA9 = Cells(gyo9, retu9).Address

If gyo_cnt < tate =" 1" tate =" 1" i =" 1" i =" 1" kaisuu =" i" kubun =" InputBox("> ll100 Then ii_max = ll100
For i = 1 To ii_max 'ワークシートの数だけ繰り返す
ww(i) = Sheets(i).Name '取得したシート名を取得する
Next i
ii0 = ActiveSheet.Index

'シートの選択。ファイルが一つの場合は何回もする必要はありませんが、複数のファイルの処理を想定しています。
For i = 1 To ii_max 'ファイルが一つの場合は何回もする必要はありませんが、複数のファイルの処理を想定しています。
msg01 = msg01 & Str$(i) & "-" & ww(i) & " "
Next i
msg00 = "飛び先のシート番号を入れてください。　"
h1 = InputBox(msg00 & Str(ii_max) & "以下。　キャンセルは999。そのままのシートの場合は、0。" & vbCrLf & msg01, "シート　ジャンプ", 0)
h2 = Val(h1)
If h2 > ll100 Then Exit Sub 'キャンセルにより終了
If h2 > ii_max Then h2 = ii_max '範囲外をいれた場合は、最後のシートの指定とする。
If h2 = 0 Then h2 = ii0
Sheets(h2).Select
shname2 = ActiveSheet.Name

'ループの抜け出し
If kubun <> 1 Then Exit Do

　4.次ぎの要素の先頭座標の指定
　カーソルで先頭座標を指定します。
Set セル範囲 = Application.InputBox(Prompt:="次のセット範囲の先頭のセルを指定してください", Default:=AAA1, Left:=10, Top:=2, Type:=8)
aaa2 = セル範囲.Address

　5.SUMPRODUCTの構成要素をつくる
　この段階の指定は、1列または1行なので、指定された座標から構成要素をつくります。
　ここでも列の場合は、記号から番号、番号から記号へと変換します。
　3.に戻る

　6.計算式の貼付け先のセルの設定
Set セル範囲 = Application.InputBox(PROMPT:="'計算式の貼付け先のセルを指定してください", Default:=AAA90, Left:=10, Top:=2, Type:=8)
AAA2 = セル範囲.Address
shname2 = ActiveSheet.Name

　7.計算式の貼付け
'要素をつなげる
For i = 1 To kaisuu
a = a & hani(i) & ","
Next
a = Left$(a, Len(a) - 1) '最後のカンマを取る
a = "=sumproduct(" & a & ")"
' a = "xxx=sumproduct(" & a & ")"　'この場合は文字列になります
'貼付け先と同一シート名を取り除く
d = "'" & shname2 & "'!"
Do While 1
p1 = InStr(a, d)
If p1 = 0 Then Exit Do
a = Left$(a, p1 - 1) & Mid$(a, p1 + Len(d))
Loop
'計算式の貼付け
Range(aaa2).Select
Range(aaa2).Formula = a
Selection.Style = "Comma [0]"

※記述したマクロは主な部分のものです

□更なる機能アップ
SUMPRODUCTの結果を総人数などで割り、平均を求める場合があります。そこでついでに割る数があるかどうか、ある場合はその座標を指定するという機能です。
通常は加重平均をとるという事例が多いのではないでしょうか。
　例；年齢別に人数と給料額が並んでいます。全員の平均給料額はいくらですか。
　　人数の下には総人数を、給料額の下には全員の平均値を入れます。
　　まずは、総人数を、SUM関数で求めます。次に今回のマクロを使って給料の総額を求め、総人数で割って平均を求めましょう。給料額の下には全員の平均値を入れます。

△SUM関数ってSUMPRODUCT関数に似ていますよね。同時にできないのでしょうか。
＝⇒同時にはできませんが、SUMPRODUCT関数を作るマクロで、一列(行)のみの指定であった場合は、SUM関数とするというのはどうでしょうか。そうすれば一つのマクロで二つの関数が作成できます。

△総人数と平均値を入れる場所は近いですね。
＝⇒そうです。ですから割る数と入れる場所と計算式を入れる場所の指定の際の初期値は工夫をするといいと思います。カーソルの移動が非常に便利になります。

△たてかける横のSUMPRODUCT関数はどうでしょうか。
＝⇒用途があるのでしょうか。まったくないとはいえませんが、かなりまれではないでしょうか。たてか横で作って計算式を修正したらどうでしょうか。そもそもSUMPRODUCT関数でそんなことができるのでしょうか。
＝⇒できませんでした。#VALUE!となってしまいました。

△そのような事例が出てきたらどうしましょうか。
＝⇒どちらかを変形して、たて同士、横同士にしてからという考えはどうでしょうか。たてを横にするとかいうのは、すでにやったような気がします。
『第18回目　凝った計算式の作り方』で取り上げていました。しかし、これはエクセルマクロの計算式で行うもので、ちょっと操作が多くなります。

△二次元の表の加重平均はどうなりますか。
＝⇒テーマは、たて6区分、横54区分に分けられた人数と給料(平均)があります。これの合計レベルの平均の給料を求めるということになります。
　まずは、人数のたて計、横計をとります。
　次に、給料の横計は、人数表の1行目と給料表の1行目のSUMPRODUCT関数の平均額となります。
　これを通常のコピーで、他の横計のセルに計算式をコピーします。
　給料のたて計は、人数表の1列目と給料表の1列目のSUMPRODUCT関数の平均額となります。
　これを通常のコピーで、他のたて計のセルに計算式をコピーします。