EXCEL VBA で多くのサンプルから平均値が同じになるように代表を

質問

EXCEL　VBA　で多くのサンプルから平均値が同じになるように代表を選びたい。
お世話になります。
稲や麦などは１株に数本の穂を付けます。今、沢山の株を抜いてきまして、一株づつ穂の数を数えました。そして、この稲は平均何本の穂が付いているかを計算しました。

そこで、本題です。この沢山抜いてきた稲の株から数株選びたいと思っています。条件は先ほど計算した平均の値と選ぶ株の値が小数第１位くらいまで一致するように選ぶ。また、選ぶ株は平均値に近い株を選ぶ事としたいのです。

上段の例は１株に２本の穂を付けている株が５株、３本付けている株が５株・・・８本付けている株が７株合った場合を示しました。（全体で８０株あります）

これから、平均値の１株当たり5.2本となるように１０株選びます。例では５本穂を付けている株を８株、６本穂を付けている株を２株選べば選んだ代表株の平均値が5.2本になります。これを計算させるプログラムはどのように考えれば良いのでしょうか？

For Next文とIf文を使って、１株選ぶ毎に平均値を計算させて、基の平均値よりも大きい時は平均値より少ない穂の株を選び、逆に小さい時は平均値よりも大きい穂の株を選ぶというコードを考えて見たのですが、時々全体の平均値と選んだ株の平均値が合わなくなる時があります。多分、下段の図のような選べる株が無くなってしまった時に大きすぎる株や小さすぎる株を選んでしまい、全体の平均値と大きく離れてしまうと合わなくなってしまうのではないかと思います。

他に何かよい考え方はないでしょうか？

説明が下手で、わかりにくいかも知れませんが、よろしくお願いします。

回答No.5

mimeu · ベストアンサー

> できれば、選ぶ株は平均値に近い株を選択したいのです。
> 例題で言えば、基の平均が５．２なので穂数が５か６あたりの株を中心に選び

お試しいただいて光栄です。
ご希望に添うには、プログラム中の

　　Const 最初の代表値 = 6.6　　　　　　' 上端は使わないこと

の値を変更します。これは名前が不適切で申し訳ないのですが、
代表に使うサンプルの偏差を示します。つまり 6.6 とは、
偏差が +6.6 ～ 0 ～ -6.6 のサンプルを抜き出そう、ということです。

なので、平均 5.2 で、穂数が５か６あたりなら、これを 0.8 か 1.0 ほどにすれば
よいハズです。よろしければお試し下さい。

お礼

mimeuさん、ありがとうございました。
「最初の代表値」ってそういう意味だったのですね。
率直に感心しました。

教えていただいた、コードを基に目的のコードを完成させたいと思います。
また、解らないことがあれば質問させていただきます、その時はよろしくお願いします。

本当にご丁寧な回答ありがとうございました。

回答No.4

mimeu

' 件数が少ないので、処理速度を速くする工夫は手抜きしてます
Private Sub Get_代表(ByVal 目標値 As Double, ByVal 累積誤差 As Double, ByRef 行 As Long, ByRef 値 As Double)
　　Dim v0 As Double, v1 As Double, 修正目標 As Double, r0 As Long, r1 As Long
　　修正目標 = 目標値 + 累積誤差
　　For r0 = 開始行 To 最後行
　　　　If r0 = 開始行 Then
　　　　　　r1 = r0
　　　　　　v1 = Abs(入力シート.Cells(r0, 2) - 修正目標)
　　　　Else
　　　　　　v0 = Abs(入力シート.Cells(r0, 2) - 修正目標)
　　　　　　If v0 < v1 Then
　　　　　　　　v1 = v0
　　　　　　　　r1 = r0
　　　　　　ElseIf v0 > v1 Then
　　　　　　　　行 = r1
　　　　　　　　値 = 入力シート.Cells(r1, 2)
　　　　　　　　Exit Sub
　　　　　　End If
　　　　End If
　　Next r0
　　行 = r1
　　値 = v1
End Sub

Private Function 処理順(i0 As Integer) As Integer
　　Select Case i0
　　Case 0: 処理順 = 0
　　Case 1: 処理順 = 9
　　Case 2: 処理順 = 1
　　Case 3: 処理順 = 8
　　Case 4: 処理順 = 2
　　Case 5: 処理順 = 7
　　Case 6: 処理順 = 3
　　Case 7: 処理順 = 6
　　Case 8: 処理順 = 4
　　Case 9: 処理順 = 5
　　End Select
End Function

お礼

mimeuさん、ありがとうございました。
コードまで記載していただきまして、勉強させていただきます。

内容が読み解けていないのですが、多分、基になる値の平均からの「偏差」に注目されて選択をされているのかなぁ～と思いました。

このコードを単純に貼り付けさせていただき、使用してみました。すると、基の平均値と選択された株の平均値はピタリと一致していて、スゴイと思いました。流石です。

ただ、私の質問が悪かったのかとも思いますが・・・できれば、選ぶ株は平均値に近い株を選択したいのです。
例題で言えば、基の平均が５．２なので穂数が５か６あたりの株を中心に選び、そこが選べなくなったら（選ぶ株が無くなってしまったりして）その外側？の株を選ぶようなイメージです。

もしかして、このコードが読み解ければ解決するのかも知れません。もう少し、勉強してみます。

本当に、質問に慣れていなくて、回答を頂くたびに条件を付け足してゆくようで申し訳ありません。

ご迷惑をお掛けしますが、ご教授いただけると幸いです。

回答No.3

mimeu

Option Explicit

' 以下の５行は手でセットします
Const 開始行 = 2
Const 最後行 = 101
Const 代表の数 = 10
Const 最初の代表値 = 6.6　　　　　　' 上端は使わないこと
Const 平均値の差の許容値 = 0.05 ' 正の数で指定すること

Dim 入力シート As Worksheet, 出力シート As Worksheet

Sub Get_10代表()
　　Dim i0 As Integer, j0 As Integer, 目標平均値 As Double, 代表値の間隔 As Double
　　Dim 目標(9) As Double, 偏差 As Double, 代表行 As Long, 累積誤差 As Double
　　Dim 調整値(9) As Double, 調整点 As Integer, 出力行調整 As Long, 結果の平均 As Double, 平均範囲 As Range
　　Set 入力シート = Worksheets("Sheet2")
　　Set 出力シート = Worksheets("Sheet3")
　　Set 平均範囲 = 入力シート.Range("A" & 開始行 & ":A" & 最後行)
　　目標平均値 = Application.WorksheetFunction.Average(平均範囲)
　　出力シート.Range("A1") = "代表行"
　　出力シート.Range("B1") = "代表値"
　　出力シート.Range("C1") = "偏差"

' 代表データの偏差の目標を設定
　　代表値の間隔 = 最初の代表値 * 0.2 / 0.9
　　調整点 = 代表の数 - 2
　　目標(0) = 最初の代表値
　　For i0 = 1 To 代表の数 - 1
　　　　目標(i0) = 目標(i0 - 1) - 代表値の間隔
　　Next i0

近そうな代表を選んでみる:
　　結果の平均 = 0
　　For j0 = 0 To 代表の数 - 1
　　　　i0 = 処理順(j0)
　　　　Get_代表 目標(i0) + 調整値(i0), 累積誤差, 代表行, 偏差
　　　　累積誤差 = 累積誤差 + 目標(i0) - 偏差
　　　　出力シート.Cells(i0 + 2 + 出力行調整, 1) = 代表行
　　　　出力シート.Cells(i0 + 2 + 出力行調整, 2) = 入力シート.Cells(代表行, 1)
　　　　出力シート.Cells(i0 + 2 + 出力行調整, 3) = 偏差
　　　　結果の平均 = 結果の平均 + 入力シート.Cells(代表行, 1)
　　Next j0
　　結果の平均 = 結果の平均 / 代表の数
　　出力シート.Cells(出力行調整 + 12, 1) = "目標平均値"
　　出力シート.Cells(出力行調整 + 12, 2) = 目標平均値
　　出力シート.Cells(出力行調整 + 13, 1) = "結果の平均"
　　出力シート.Cells(出力行調整 + 13, 2) = 結果の平均
　　出力シート.Cells(出力行調整 + 14, 1) = "平均値の差"
　　出力シート.Cells(出力行調整 + 14, 2) = 結果の平均 - 目標平均値

' 結果を見て気に入らなければ手直しする
　　If Abs(結果の平均 - 目標平均値) < 平均値の差の許容値 Then Exit Sub
　　調整点 = 調整点 - 1
　　If 調整点 < 1 Then Exit Sub
　　For i0 = 0 To 9
　　　　調整値(i0) = 0
　　Next i0
　　調整値(調整点) = 代表値の間隔 / 2#　　' これはドテカンです
　　出力行調整 = 15
　　GoTo 近そうな代表を選んでみる
End Sub

お礼

mimeuさん回答ありがとうございました。
お礼率が下がってしまってはいけないと思い、それぞれの回答にお礼をさせていただきます。

回答No.2

mimeu

統計学のことは分かりませんが、職人の手なぐさみに試しました。
サンプル数が少なそうなお話ですから、こんなプログラムを読むより
手作業で目的を達したほうが速いかもしれません。　　（＾－＾）

(1) シート内にサンプル値の偏差をセットする
(2) サンプルデータを偏差の降順に並べ替える
(3) 目指す１０個のサンプル代表者にふさわしい候補像（値）を等間隔に
　　設定する。このとき最大値、最小値の両端は使わないようにする。
(4) 一番上の候補像に一番近い代表を選ぶ
(5) 一番下の候補像に一番近い代表を選ぶ
　　このときの選択で (4) で出た誤差を調整する
(6) 同様に上から２番目に大きい代表を選ぶ
　　→ これを１０個目のサンプルに至るまで繰り返す
(7) 結果として選んだ代表の平均値に満足すれば、それで終わり。
　　満足しなければ、途中の段階（最後から順にどこか１箇所）の選択を動かして
　　（プログラム中『調整値(i0)』というのがそれです）
　　再度、同じ事をして (7) に戻る。
　　それでも不満足なら選択を動かす段階をより初期にもどしていく。

という考え方で作ったのが下記の Ｅｘｃｅｌ　ＶＢＡ プログラムです。
乱数で作ったデータで動作確認しています。

前提は Sheet2 のＡ列に穂の数、Ｂ列にその偏差が入っている。
選んだ代表は Sheet3 に出力する。

なお、同じサンプルが重複して代表に選ばれることを避けるチェックは
していませんので、結果を見てもし重複していれば、同じ値の別の
サンプルを使うようにして下さい。

２０００文字しか投稿できないので、プログラムは以下２件に分割します

お礼

mimeuさん、回答ありがとうございました。
完全に理解するにはまだ至っていませんが、親切な解説をしていただきありがとうございました。

回答No.1

osamuy

モンテカルロ法で、ランダムに10本選ぶのを10程度回繰り返して、そのなかでもっとも平均値に近いセットを代表とするってのは。

参考URLは、rubyでのコード。Excelを立ち上げるのが面倒だったので。

参考URL：

http://codepad.org/nrUWzDOA

お礼

早速のご回答ありがとうございます。
「後出しじゃんけん」のようで申し訳ないのですが、私VBAのコードを書くのは初心者にチョット毛が生えたくらいでして・・・（そんな者が解決できる話ではないとのご指摘があるかも知れませんが）

モンテカルロ法につきましては、少しだけ調べました。乱数を発生させて何回かの結果を出してそこから条件に合う物を選ぶという事でしょうか？

少し、挑戦してみます。（かなり、壁は高そうですが・・・）

ひとつ、ご教授いただきたいことがあります。乱数でシミュレーションすると上段の図と下段の図両方とも平均値は同じになりますが、株数に余裕があれば上段の方を優先させたいのですが、どのように判断すれば良いでしょうか？

本当に面倒な質問者で申し訳ありません。よろしくお願いします。