Excel VBA質問箱 IV

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

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


74999 / 76732 ←次へ | 前へ→

【6182】Re:複数の数値の合計が指定した数になるよ...
発言  ichinose  - 03/6/18(水) 12:45 -

引用なし
パスワード
   ▼LC さん:
▼よしこ さん:
こんにちは。
前に組み合わせのご質問があったときに作ったコードをそのまま使いました。
「A列の組み合わせ合計がセルC1と同じになった値をD列に貼り付けました」
標準モジュールに
'=======================================================
Dim ans_rng As Range
Sub main()
  Dim rng As Range
  Dim ans()
  Dim 抜取数 As Long
  Dim ques
  Dim mysum
  Set ans_rng = Nothing
  ques = Range("c1").Value
  Set rng = Range("a1", Cells(Rows.Count, 1).End(xlUp))
  見つけた = False
  For 抜取数 = 1 To rng.Count
   cnt = comb(ans(), rng, 抜取数)
   For idx = 1 To cnt
    mysum = 0
    For jdx = 1 To 抜取数
     mysum = mysum + ans(idx, jdx)
     Next jdx
    If mysum = ques Then
      For kdx = 1 To 抜取数
       If ans_rng Is Nothing Then
        Set ans_rng = rng.Cells(WorksheetFunction.Match(ans(idx, kdx), rng, 0))
       Else
        Set ans_rng = Union(ans_rng, rng.Cells(WorksheetFunction.Match(ans(idx, kdx), rng, 0)))
        End If
       Next kdx
      Exit For
      End If
    Next idx
   If Not ans_rng Is Nothing Then Exit For
   Next 抜取数
  If Not ans_rng Is Nothing Then
    MsgBox "見つけた"
    ans_rng.Copy Range("d1")
  Else
    MsgBox "駄目だった"
    End If
End Sub
'========================================================================
Function comb(ans(), Optional rng As Range = Nothing, Optional seln As Long = 0, Optional ByVal myx As Long = 0, Optional ByVal ctx As Long = 0) As Long
'input rng : 組み合わせメンバーセル範囲
'   seln: 抜き取り数
'out  ans() 組み合わせリスト
'   mxy ctx は 内部パラメータ指定不可
  Dim crng As Range
  Static svn As Long
  Static myarray()
  Static idx As Long
  Static gyou As Long
  Static mylim As Long
  Dim cnt As Long
  If seln > 0 Then
    svn = seln
    Erase myarray
    i = 1
    For Each crng In rng
     ReDim Preserve myarray(1 To i)
     myarray(i) = crng.Value
     i = i + 1
     Next
    mylim = rng.Count
    myx = 1
    gyou = WorksheetFunction.Combin(rng.Count, seln)
    comb = gyou
    ReDim ans(1 To gyou, 1 To svn)
    ctx = 1
    idx = 1
    End If
  cnt = 0
  Do While myx <= mylim And idx <= gyou
   If cnt > 0 And idx > 1 Then
     For i = 1 To ctx - 1
      ans(idx, i) = ans(idx - 1, i)
      Next
     End If
   ans(idx, ctx) = myarray(myx)
   If ctx + 1 <= svn Then
     Call comb(ans(), , , myx + 1, ctx + 1)
     End If
   myx = myx + 1
   idx = idx + 1
   cnt = cnt + 1
   Loop
  idx = idx - 1
End Function
'削除は、以下のコード
'=======================================================
Sub delete_rng()
  If Not ans_rng Is Nothing Then
    ans_rng.Delete xlUp
    End If
End Sub

0 hits

【6113】複数の数値の合計が指定した数になるようにしたいのですが・・・ よしこ 03/6/16(月) 22:03 質問
【6151】Re:複数の数値の合計が指定した数になるよう... LC 03/6/17(火) 18:19 質問
【6153】Re:複数の数値の合計が指定した数になるよ... よしこ 03/6/17(火) 20:39 質問
【6157】Re:複数の数値の合計が指定した数になるよ... LC 03/6/17(火) 23:08 発言
【6159】Re:複数の数値の合計が指定した数になるよ... よしこ 03/6/18(水) 0:46 お礼
【6161】Re:複数の数値の合計が指定した数になるよ... LC 03/6/18(水) 6:24 質問
【6179】Re:複数の数値の合計が指定した数になるよ... LC 03/6/18(水) 12:30 回答
【6182】Re:複数の数値の合計が指定した数になるよ... ichinose 03/6/18(水) 12:45 発言
【6192】Re:複数の数値の合計が指定した数になるよ... よしこ 03/6/18(水) 21:52 お礼

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