Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


11399 / 13645 ツリー ←次へ | 前へ→

【16249】平均値の参照 hideo 04/7/22(木) 10:36 質問[未読]
【16251】Re:平均値の参照 ichinose 04/7/22(木) 10:52 発言[未読]
【16252】Re:平均値の参照 hideo 04/7/22(木) 11:12 お礼[未読]
【16273】Re:平均値の参照 ichinose 04/7/22(木) 21:32 発言[未読]
【16286】Re:平均値の参照 hideo 04/7/23(金) 12:09 発言[未読]
【16288】Re:平均値の参照 ichinose 04/7/23(金) 13:19 回答[未読]
【16304】Re:平均値の参照 hideo 04/7/23(金) 17:05 お礼[未読]

【16249】平均値の参照
質問  hideo  - 04/7/22(木) 10:36 -

引用なし
パスワード
   こんにちは、教えて下さい。

入力を行うセルに次の通り整数が入力されているとします。
A1=5 B1=3 C1=4 D1=6 E1=1

回答を求めるセル
A3,B3にできるだけA3,B3を比較して均等になるように回答を算出するにはどのようにすればよいでしょうか?

関数ではif関数を使えば力技で何とかなりそうですが、A3,B3を比較してというところでひっかります。

全くの初心者ですいません。宜しくお願い致します。

【16251】Re:平均値の参照
発言  ichinose  - 04/7/22(木) 10:52 -

引用なし
パスワード
   ▼hideo さん:
こんにちは。

>入力を行うセルに次の通り整数が入力されているとします。
>A1=5 B1=3 C1=4 D1=6 E1=1


>回答を求めるセル
>A3,B3にできるだけA3,B3を比較して均等になるように回答を算出するにはどのようにすればよいでしょうか?

比較結果まで記述して頂かないとどういう処理をしなければならないのか
わかりませんでした。
セルA3、B3には、例えば、どんな値が入っているのでしょうか?
また、その場合、どんな結果を導きたいのでしょうか?
セルA1〜E1の場合のように具体的な値を例に示して下さい。

【16252】Re:平均値の参照
お礼  hideo  - 04/7/22(木) 11:12 -

引用なし
パスワード
   ▼ichinose さん:
こんにちは。

すいません。ご指摘ありがとう御座います。

>比較結果まで記述して頂かないとどういう処理をしなければならないのか
>わかりませんでした。
>セルA3、B3には、例えば、どんな値が入っているのでしょうか?
>また、その場合、どんな結果を導きたいのでしょうか?
>セルA1〜E1の場合のように具体的な値を例に示して下さい。

A3,B3には

A3=9(A1+C1)
B3=10(B1+D1+E1)

のようにA1・B1・C1・D1・E1をそれぞれ1バッチとして扱い、バッチは崩さずに、A3とB3が出来るだけ平均になるように結果を導きたいと思っています。

宜しくお願い致します。。

>▼hideo さん:
>こんにちは。
>
>>入力を行うセルに次の通り整数が入力されているとします。
>>A1=5 B1=3 C1=4 D1=6 E1=1
>
>
>>回答を求めるセル
>>A3,B3にできるだけA3,B3を比較して均等になるように回答を算出するにはどのようにすればよいでしょうか?
>
>比較結果まで記述して頂かないとどういう処理をしなければならないのか
>わかりませんでした。
>セルA3、B3には、例えば、どんな値が入っているのでしょうか?
>また、その場合、どんな結果を導きたいのでしょうか?
>セルA1〜E1の場合のように具体的な値を例に示して下さい。

【16273】Re:平均値の参照
発言  ichinose  - 04/7/22(木) 21:32 -

引用なし
パスワード
   ▼hideo さん:
こんばんは。
正直、まだ仕様がわかりません。
わからない個所は・・・・、

>A3,B3には
>
>A3=9(A1+C1)
>B3=10(B1+D1+E1)

この式が???
だって、A1+C1というように決まっているなら
何をどう変更するのでしょうか?

>
>のようにA1・B1・C1・D1・E1をそれぞれ1バッチとして扱い、バッチは崩さずに、A3とB3が出来るだけ平均になるように結果を導きたいと思っています。

と言われてますが、「バッチを崩さずに」という表現の真意がわかりません。
私の拙い知識では、バッチとは、あるまとまった情報の塊だと理解しています。
それを崩さずに??、わかりません。
逆に崩すというのはどういう場合を想定されていますか?

>>>A1=5 B1=3 C1=4 D1=6 E1=1
>>
>>
>>>回答を求めるセル
>>>A3,B3にできるだけA3,B3を比較して均等になるように回答を算出するにはどのようにすればよいでしょうか?
均等になるように何をするのでしょうか?


で、わからないながらも仕様を想像してみました。

hideo さんが入力データとして、ご提示されたセルA1〜E1ここには、
例えばのデータとして、

>>>A1=5 B1=3 C1=4 D1=6 E1=1

これが入っているんですよね?


これを

セルA3には、「=9*(x+y)」
セルB3には、「=10*(α+β+γ)」

と言う式にセルA1〜E1の値を組み合わせて計算し、その差(B3-A3の絶対値)が一番小さい組合せを探すという仕様を想定しました。

つまり、例のようにセルA1〜E1に値が入っているとすると、

A3には、「=9*sum($C$1:$D$1)」の答え、90
B3には、「=10*sum($A$1,$B$1,$E$1)」の答え、90
その差は、0

こういう意味なら、ちょっと前に、似たようなコードを書きましたから、
作成する事は出来ると思いますが・・・。

もし、私の想定がとんでもなくhideo さんが意図している仕様とかけ離れていた場合、

入力データと出力データが何なのか?
こういう入力データなら出力として、こんな結果が得たいと言う例を
3パターンぐらい記述して頂くと私でも理解できると思います。

こういう仕様を明確に記述するのは、本当に難しい事だと思いますが、
よろしくお願いします。

【16286】Re:平均値の参照
発言  hideo  - 04/7/23(金) 12:09 -

引用なし
パスワード
   ▼ichinose さん:
こんにちは。すいません。説明不足ですね。
>>A3,B3には
>>
>>A3=9(A1+C1)
>>B3=10(B1+D1+E1)
>
>この式が???
>だって、A1+C1というように決まっているなら
>何をどう変更するのでしょうか?

例えばの事で、A3とB3には固定された算出式が入るのではなく、A3とB3が出来るだけ同じ値になるように理想の組み合わせを探すようにします。今回の場合はA3=A1+C1だという事です。

>>のようにA1・B1・C1・D1・E1をそれぞれ1バッチとして扱い、バッチは崩さずに、A3とB3が出来るだけ平均になるように結果を導きたいと思っています。
>
>と言われてますが、「バッチを崩さずに」という表現の真意がわかりません。
>私の拙い知識では、バッチとは、あるまとまった情報の塊だと理解しています。
>それを崩さずに??、わかりません。
>逆に崩すというのはどういう場合を想定されていますか?
>
バッチを崩すという表現は適切ではなかったかもしれません。

例えば、(A1+B1+C1+D1+E1)/2 で算出されると数値が混じってしまう事になるので記入しました。

>>>>A1=5 B1=3 C1=4 D1=6 E1=1
>>>
>>>
>>>>回答を求めるセル
>>>>A3,B3にできるだけA3,B3を比較して均等になるように回答を算出するにはどのようにすればよいでしょうか?
>均等になるように何をするのでしょうか?
>
>
>で、わからないながらも仕様を想像してみました。
>
>hideo さんが入力データとして、ご提示されたセルA1〜E1ここには、
>例えばのデータとして、
>
>>>>A1=5 B1=3 C1=4 D1=6 E1=1
>
>これが入っているんですよね?
>
>
>これを
>
>セルA3には、「=9*(x+y)」
>セルB3には、「=10*(α+β+γ)」
>
>と言う式にセルA1〜E1の値を組み合わせて計算し、その差(B3-A3の絶対値)が一番小さい組合せを探すという仕様を想定しました。
>
>つまり、例のようにセルA1〜E1に値が入っているとすると、
>
>A3には、「=9*sum($C$1:$D$1)」の答え、90
>B3には、「=10*sum($A$1,$B$1,$E$1)」の答え、90
>その差は、0
>
>こういう意味なら、ちょっと前に、似たようなコードを書きましたから、
>作成する事は出来ると思いますが・・・。
>
>もし、私の想定がとんでもなくhideo さんが意図している仕様とかけ離れていた場合、
>
>入力データと出力データが何なのか?
>こういう入力データなら出力として、こんな結果が得たいと言う例を
>3パターンぐらい記述して頂くと私でも理解できると思います。
>
>こういう仕様を明確に記述するのは、本当に難しい事だと思いますが、
>よろしくお願いします。

今回の入力データは、入力するデータの種類でワーカーに不公平が内容振り分けるために出来るだけ近い数値を導き出そうとしています。但し、1種類のデータが2人に分かれてしまうと、作業場不備がおこるため、種目単位でワーカーに振り分けるとこになります。

拙い説明ですいません。宜しくお願いします。

【16288】Re:平均値の参照
回答  ichinose  - 04/7/23(金) 13:19 -

引用なし
パスワード
   ▼hideo さん:
こんにちは。

>>>A3,B3には
>>>
>>>A3=9(A1+C1)
↑これ、9*(x+y) ではなく、単純な足し算の答えと内訳だったのですね
これは、わかりましたが・・・。

まだ、不明な点があるのですが・・・(本当は、例を2,3件記述していただきたかったんです)。

後述するコードは、

例1、

セルA1〜E1にそれぞれ 5,3,4,6,1という値が入っていた場合、
結果として、

セルA3に 9         セルB3に 10
セルA4に =sum($A$1,$C$1)  セルB4に =sum($B$1,$D$1:$E$1)

という結果を表示します。

例2

セルA1〜E1にそれぞれ 20,3,4,6,1という値が入っていた場合、
結果として、

セルA3に 20         セルB3に 14
セルA4に =sum($A$1)     セルB4に =sum($B$1:$E$1)

という結果を表示します(こういうパーターンも有りということがはっきりと
確信が持てなかったのですが、見きり発車です)。

では、コードです。

標準モジュール(Module1)に、
'===========================================================
Sub main()
  Dim 組合せセル範囲 As Range
  Dim 抜き取り数 As Long
  Dim セル範囲1 As Range
  Dim セル範囲2 As Range
  Dim 回答1, 回答2, 式1, 式2
  Dim first_flg As Boolean
  Set 組合せセル範囲 = Range("a1:e1") 'ここの範囲は、可変にして有ります
  first_flg = True
  For 抜き取り数 = 1 To (組合せセル範囲.Count \ 2)
   Call comb_init(組合せセル範囲, 抜き取り数, 2)
   Do While separate_rng(組合せセル範囲, セル範囲1, 抜き取り数, セル範囲2) = 0
     If first_flg = True Then
      式1 = "=sum(" & セル範囲1.Address & ")"
      式2 = "=sum(" & セル範囲2.Address & ")"
      回答1 = WorksheetFunction.Sum(セル範囲1)
      回答2 = WorksheetFunction.Sum(セル範囲2)
      first_flg = False
     Else
      If Abs(回答2 - 回答1) > Abs(WorksheetFunction.Sum(セル範囲2) - WorksheetFunction.Sum(セル範囲1)) Then
        式1 = "=sum(" & セル範囲1.Address & ")"
        式2 = "=sum(" & セル範囲2.Address & ")"
        回答1 = WorksheetFunction.Sum(セル範囲1)
        回答2 = WorksheetFunction.Sum(セル範囲2)
        End If
      End If
     Loop
   Next
  Range("a3").Value = 回答1
  Range("a4").Value = "'" & 式1
  Range("b3").Value = 回答2
  Range("b4").Value = "'" & 式2
End Sub
'===================================================================
Function separate_rng(origin_rng As Range, rng1 As Range, rng1_cnt As Long, rng2 As Range) As Long
'組合せメンバーと非メンバーの二つのセル範囲を取得する
'input  :  origin_rng  組合せ対象セル範囲
'    :  rng1_cnt   rng1に入れるセルの数
'output :  rng1 ,rng2  : 分けられたセル範囲
'      separate_rng : 0-正常に取得 1-データの終わり
  ReDim ans(1 To rng1_cnt)
  separate_rng = 1
  If get_comb(ans()) = 0 Then
   Set rng1 = Range(Join(ans(), ","))
   Set rng2 = Nothing
   For Each crng In origin_rng
     If Application.Intersect(crng, rng1) Is Nothing Then
      If rng2 Is Nothing Then
        Set rng2 = crng
      Else
        Set rng2 = Union(rng2, crng)
        End If
      End If
     Next crng
   separate_rng = 0
   End If
End Function


次に標準モジュール(Module2)に
'===================================================================
  Private c_svn As Long
  Private c_myarray()
  Private c_idx() As Long
  Private cs_x() As Long
Function comb_init(rng As Range, seln As Long, Optional val_typ As Long = 1) As Double
'組合せ処理の初期化
'input : rng : 組合せを行うセル範囲
'    seln: 抜き取り数
'  val_type: セル範囲rngのどのプロパティを組み合わせ対象とするかのフラグ
'       1 - value 2- address 3-text
'outptu: comb_init --- 組合せ数
  c_svn = seln
  Erase c_myarray
  Erase c_idx
  Erase cs_x()
  i = 1
  For Each crng In rng
   ReDim Preserve c_myarray(1 To i)
   c_myarray(i) = Choose(val_typ, crng.Value, crng.Address, crng.Text)
   i = i + 1
   Next
  ReDim cs_x(1 To seln)
  ReDim c_idx(1 To seln)
  For i = 1 To UBound(c_idx())
   cs_x(i) = i
   c_idx(i) = i
   Next
  c_idx(UBound(c_idx())) = c_idx(UBound(c_idx())) - 1
  comb_init = WorksheetFunction.Combin(rng.Count, seln)
End Function
'===================================================================
Function get_comb(ans()) As Long
'組合せメンバを配列に取得する
'output : ans() : 組合せメンバー(引数は、1から始まる)
'      get_comb : 0-正常に取得 1-データの終わり
  get_comb = 1
  For i = UBound(c_idx()) To LBound(c_idx()) Step -1
    If c_idx(i) + 1 <= UBound(c_myarray()) - c_svn + i Then
     c_idx(i) = c_idx(i) + 1
     get_comb = 0
     Exit For
    Else
     c_idx(i) = cs_x(i) + 1
     cs_x(i) = cs_x(i) + 1
     For j = i + 1 To UBound(cs_x())
      cs_x(j) = cs_x(j - 1) + 1
      c_idx(j) = cs_x(j)
      Next j
     End If
    Next
  If get_comb = 0 Then
    For i = LBound(c_idx()) To UBound(c_idx())
     ans(i) = c_myarray(c_idx(i))
     Next
    End If
End Function

コードは、以上です。
これで、アクティブシートのセルA1〜E1に値を設定して
プロシジャーmainを実行してみて下さい。

【16304】Re:平均値の参照
お礼  hideo  - 04/7/23(金) 17:05 -

引用なし
パスワード
   拙い質問文に対して、色々とご親切にして頂きありがとう御座いました。

教えていただいたロジックを元に色々と勉強させて頂きます。

11399 / 13645 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free