Excel VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
4439 / 13644 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【54034】郵便切手の組合せについて 新参者 08/2/20(水) 20:01 質問[未読]
【54037】Re:郵便切手の組合せについて りん 08/2/20(水) 20:56 回答[未読]
【54089】Re:郵便切手の組合せについて ［名前なし］ 08/2/24(日) 1:07 回答[未読]
【56671】Re:郵便切手の組合せについて 新参者 08/6/29(日) 16:44 お礼[未読]
【56670】Re:郵便切手の組合せについて 新参者 08/6/29(日) 16:42 お礼[未読]
【54034】郵便切手の組合せについて
質問  新参者  - 08/2/20(水) 20:01 -
引用なし
パスワード
   会社で切手管理をしています｡
切手の組合せプロシージャを教えて下さい。
条件切手5種類　使用制限4枚
例　郵便料230円　 切手　枚 枚 枚 枚　枚
　　　　　　　　　10円　1　2　　 1
　　　　　　　　　50円　1　　 1　2　 3
　　　　　　　　　80円　1　　　　　　1
　　　　　　　　　90円　1　1　2
　　　　　　　　 120円　　 1　　 1
　　　　　　　　 　計　 4　4　3　4　 4
上記の様になれば良いのですが・・・
下記のﾌﾟﾛｼｰｼﾞｬでは１パターンしか表示されません。
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
' 切手組み合わせ()
Dim I As Integer, J As Integer, K As Integer, L As Integer, M As Integer

For I = 0 To 4
For J = 0 To 4
For K = 0 To 4
For L = 0 To 4
For M = 0 To 4

If Range("A2") = 10 * I + 50 * J + 80 * K + 90 * L + 120 * M
And I + J + K + L + M <= 4 Then

Range("C3") = I　'10円切手枚数
Range("C4") = J　'50円切手枚数
Range("C5") = K　'80円切手枚数
Range("C6") = L　'90円切手枚数
Range("C7") = M　'120円切手枚数
End If
Next
Next
Next
Next
Next

End Sub
【54037】Re:郵便切手の組合せについて
回答  りん E-MAIL  - 08/2/20(水) 20:56 -
引用なし
パスワード
   新参者 さん、こんばんわ。

>下記のﾌﾟﾛｼｰｼﾞｬでは１パターンしか表示されません。
>Private Sub Worksheet_SelectionChange(ByVal Target As Range)
>' 切手組み合わせ()
>Dim I As Integer, J As Integer, K As Integer, L As Integer, M As Integer
　（略）
>
>End Sub

ヒットしたパターンを全部表示していきたいということですかね。

Private Sub Worksheet_Change(ByVal Target As Range)
　 'A2が変わったら実行
　 If Target.Address = "$A$2" Then
　　　'イベントキャンセル
　　　Application.EnableEvents = False
　　　'切手組み合わせ()
　　　Dim I As Integer, J As Integer, K As Integer, L As Integer, M As Integer
　　　Dim Cpos As Long
　　　'
　　　Cpos = 3 'C列から
　　　For I = 0 To 4
　　　　 For J = 0 To 4
　　　　　　For K = 0 To 4
　　　　　　　 For L = 0 To 4
　　　　　　　　　For M = 0 To 4
　　　　　　　　　　 If (I + J + K + L + M) <= 4 Then
　　　　　　　　　　　　If Range("A2").Value = 10 * I + 50 * J + 80 * K + 90 * L + 120 * M Then
　　　　　　　　　　　　　 '
　　　　　　　　　　　　　 Cells(3, Cpos).Value = I　'10円切手枚数
　　　　　　　　　　　　　 Cells(4, Cpos).Value = J　'50円切手枚数
　　　　　　　　　　　　　 Cells(5, Cpos).Value = K '80円切手枚数
　　　　　　　　　　　　　 Cells(6, Cpos).Value = L '90円切手枚数
　　　　　　　　　　　　　 Cells(7, Cpos).Value = M '120円切手枚数
　　　　　　　　　　　　　 Cpos = Cpos + 1　'列番号を＋１
　　　　　　　　　　　　End If
　　　　　　　　　　 End If
　　　　　　　　　Next
　　　　　　　 Next
　　　　　　Next
　　　　 Next
　　　Next
　　　'戻す
　　　Application.EnableEvents = True
　 End If
End Sub

こんな感じです。
クリアはしていません。
【54089】Re:郵便切手の組合せについて
回答  ［名前なし］  - 08/2/24(日) 1:07 -
引用なし
パスワード
   さらに※のようにすると、ループ回数が減ります。

Private Sub Worksheet_Change(ByVal Target As Range)
　　'A2が変わったら実行
　　If Target.Address = "$A$2" Then
　　　　'イベントキャンセル
　　　　Application.EnableEvents = False
　　　　'切手組み合わせ()
　　　　Dim I As Integer, J As Integer, K As Integer, L As Integer, M As Integer
　　　　Dim Cpos As Long
　　　　'
　　　　Cpos = 3 'C列から
　　　　For I = 0 To 4
　　　　　　For J = 0 To 4 - I '←※既に選択されている分を引く
　　　　　　　　For K = 0 To 4 - (I + J) '←※
　　　　　　　　　　For L = 0 To 4 - (I + J + K) '←※
　　　　　　　　　　　　For M = 0 To 4 - (I + J + K + L) '←※
　　　　　　　　　　　　　　'ここにあったI〜Mの合計使用枚数判定は不要
　　　　　　　　　　　　　　If Target.Value = 10 * I + 50 * J + 80 * K + 90 * L + 120 * M Then
　　　　　　　　　　　　　　　　'
　　　　　　　　　　　　　　　　Cells(3, Cpos).Value = I　'10円切手枚数
　　　　　　　　　　　　　　　　Cells(4, Cpos).Value = J　'50円切手枚数
　　　　　　　　　　　　　　　　Cells(5, Cpos).Value = K　'80円切手枚数
　　　　　　　　　　　　　　　　Cells(6, Cpos).Value = L　'90円切手枚数
　　　　　　　　　　　　　　　　Cells(7, Cpos).Value = M　'120円切手枚数
　　　　　　　　　　　　　　　　Cpos = Cpos + 1　'列番号を＋１
　　　　　　　　　　　　　　End If
　　　　　　　　　　　　Next
　　　　　　　　　　Next
　　　　　　　　Next
　　　　　　Next
　　　　Next
　　　　'戻す
　　　　Application.EnableEvents = True
　　End If
End Sub
【56670】Re:郵便切手の組合せについて
お礼  新参者  - 08/6/29(日) 16:42 -
引用なし
パスワード
   大変遅くなりましたが　ありがとうございました。
【56671】Re:郵便切手の組合せについて
お礼  新参者  - 08/6/29(日) 16:44 -
引用なし
パスワード
   訳あり入院していました。大変遅くなりましたがありがとうございました。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
4439 / 13644 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free