Excel VBA質問箱 IV

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

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


51443 / 76732 ←次へ | 前へ→

【30156】Re:データの中から、合計にあったデータを抜き出す
発言  ichinose  - 05/10/20(木) 19:14 -

引用なし
パスワード
   ▼ヒロヒロ さん:
こんばんは。
似たようなご質問が過去にもありましたが・・・。
この問題、組み合わせリストを作成するコードがあれば、9割方 完成ですよね?


>1200
>1300
>1400
>1600
>1000
仮にアクティブシートの
A1〜E1にそれぞれ 1200、1300,1400,1600,1000
と 入力されているとします。

標準モジュールに

'==================================================
Sub main()
  Dim 組合せセル範囲 As Range
  Dim 抜き取り数 As Long
  Dim 合計 As Long
  Dim d_rw As Long
  合計 = 3700
  d_rw = 2
  Set 組合せセル範囲 = Range("a1:e1")
  For 抜き取り数 = 1 To 組合せセル範囲.Count
   Call comb_init(組合せセル範囲, 抜き取り数, 1)
   ReDim ans(1 To 抜き取り数)
   Do While get_comb(ans()) = 0
     If Evaluate(Join(ans(), "+")) = 合計 Then
      Range(Cells(d_rw, 1), Cells(d_rw, 抜き取り数)).Value = ans()
      d_rw = d_rw + 1
      End If
     Loop
   Next
  MsgBox "以上、" & d_rw - 2 & " 通り検出しました"
End Sub


別の標準モジュールに以前に作ったコードです。

'=========================================================
  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


これで当該シートをアクティブにした状態で
mainを実行してみてください。
合計値が一致するメンバーを
セルA2から表示します。
1 hits

【30137】データの中から、合計にあったデータを抜き出す ヒロヒロ 05/10/20(木) 14:50 質問
【30156】Re:データの中から、合計にあったデータを... ichinose 05/10/20(木) 19:14 発言

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