[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『均一配分』（やっちゃば）
おはようございます。
シャッフルで対応できるかな?と考えて見たのですが出来なかったのでお知恵をお貸しください。
10～99までの二けた番号が付いた90アイテムの商品を同類が入らないように分ます。
具体的に申しますと3品に分けた場合、根菜類から一品、果菜類から一品、山菜類から一品といったように。
品数は２品から６品まで任意に変わります。
全てわけ最後の商品(半端)は不足しても構いません。
コードで表示しVLOOKUPで品名は表します。
分類は以下の通りです。
10～19根菜類・・・ 10大 根/11春吹大根/12潰物大根/13紅大根/14からみ大根/15ミニ大根/16はねっこ大根/17葉付大根/18三浦赤大根/19人参
20～29土物類・・・20馬鈴薯/21新馬鈴薯/22秋馬鈴薯/23黄爵馬鈴薯/24メ―クイン/25馬鈴薯（ｴﾗﾌﾞｺﾞｰﾙﾄﾞ）/26雪蔵馬鈴薯/27きたあかり/28男爵馬鈴薯/29新里芋
30～39葉茎菜類
40～49果菜類
50～59豆科野菜類
60～69きのこ類
70～79香辛つま物類
80～89山菜類
90～99果実
＜ 使用 Excel：Excel2013、使用 OS：Windows7 ＞
各分類の頭から順に取り出して行けばいい様な気がするんですけど、
4品の場合なら 10,20,30,40 50,60,70,80 90,11,21,31 ：： それじゃダメなんですか？ 他にまだ説明されていない条件でもあるんでしょうか？
（半平太） 2015/05/20(水) 11:56
（やっちゃば） 2015/05/21(木) 08:39
（やっちゃば） 2015/05/21(木) 09:11
＞そうですねぇー ＞朝が早いのでぼけています。 ＞ 気づきませんでした。
あれ？ 本当にそうなんですか？
あの後、「均一配分」「シャッフル」とかの意味やハンドルネーム(やっちゃば）から推測して、 バラエティに富んだ野菜類の山盛りを沢山作りたいのかなぁ、なんて思っていたのですけど。
上の案だと、いつもそばにある分類同士でくっついてしまいます。
＞M3のセルに"B3:J3"この様に書きました。
＞コードには Range(Range("M3")).Selectこの様に書きました。
＞するとRangeメソッドは失敗しましたのエラーが出ます。
可能性としては、 １．そのコードはシートモジュールに書いたが、実行する時、別のシートを前面にしていた。 ２．M2セルにダブルクォーテーションマークも付けて「"B3:J3"」とそのまんま書いた
（半平太） 2015/05/21(木) 09:45
バラエティに富んだ野菜類の山盛りを沢山作りたいのかなぁ 想像の通りです。
横のシャッフル後に、縦のシャッフルを行いできるかと思っていたのですがお勧めはありますか?
（やっちゃば） 2015/05/21(木) 10:11
＞お勧めはありますか お勧めできるほどのものはないですが、 こんな展開になるかも知れないと思って、しどろもどろに検討したものはあります。
まだ、アップできる状態ではないので、整理できたらアップします。
（半平太） 2015/05/21(木) 10:24
「処理」シートを新規に挿入して、シート見出しを右クリックして「コードの表示」を選ぶと シートモジュールが表れますので、後記コードを貼り付けてください。
M2セルに品数(2～6)を入力してから、上記マクロ(Grouping）を実行してください。 結果はO(オー)列の品名以下に表示されます。
<処理> 結果例 行 _____A_____ ___B___ __C__ _____D_____ __E__ ____F____ ____G____ _____H_____ __I__ __J__ __K__ ___L___ _____M_____ ____N____ _____ O _____ 1 RAND コード 10台 修正RAND Rank 修正Rank 採用Item 結果コード 抽出 10台 分類 採用数 品数 グループ 品名 2 0.311611117 10 10 0.311611117 31 1 14 68 60 10 10 4 1 14からみ大根 3 0.503145566 11 10 0.503145566 23 1 24 54 50 20 10 セット総数 24メ―クイン 4 0.854127938 12 10 0.854127938 10 1 56 49 40 30 10 22 56豆科07 5 0.342892096 13 10 0.342892096 28 1 97 37 30 40 10 97果実08 6 0.972051288 14 10 0.972051288 1 1 67 50 10 2 67きの08 7 0.695476094 15 10 0.695476094 17 1 74 60 10 74香辛05 8 0.327110815 16 10 0.327110815 30 1 87 70 10 87山菜08 9 0.329114533 17 10 0.329114533 29 1 40 80 9 40果菜01 10 0.778277822 18 10 0.778277822 12 1 30 90 9 3 30葉茎 ： : ：
但し「品名リスト」シートは以下の構成になっているものとします。
<品名リスト> サンプルデータ 行 __A__ _____B_____ ____C____ _____D_____ _____E_____ ______F______ ______G______ ___________H___________ _______I_______ ______J______ ______K______ ____L____ 1 大台 分類 Item01 Item02 Item03 Item04 Item05 Item06 Item07 Item08 Item09 Item10 2 10 根菜類 10大根 11春吹大根 12物大根 13紅大根 14からみ大根 15ミニ大根 16はねっこ大根 17葉付大根 18三浦赤大根 19人参 3 20 土物類 20馬鈴薯 21新馬鈴薯 22秋馬鈴薯 23黄爵馬鈴薯 24メ―クイン 25馬鈴薯（ｴﾗﾌﾞｺﾞｰﾙﾄﾞ） 26雪蔵馬鈴薯 27きたあかり 28男爵馬鈴薯 29新里芋 4 30 葉茎菜類 30葉茎 31葉茎 32葉茎 33葉茎 34葉茎 35葉茎 36葉茎 37葉茎 38葉茎 39葉茎 5 40 果菜類 40果菜01 41果菜02 42果菜03 43果菜04 44果菜05 45果菜06 46果菜07 47果菜08 48果菜09 49果菜10 6 50 豆科野菜類 50豆科01 51豆科02 52豆科03 53豆科04 54豆科05 55豆科06 56豆科07 57豆科08 58豆科09 59豆科10 ： : ：
’処理シートのシートモジュールに貼り付けるコード
Sub Grouping()
Dim DTI, DTL
Dim timesToTry As Long
Dim cellToWrite As Range
Dim cellToWrite2 As Range
Dim NN As Long, KK As Long
Dim idx As Long
Dim minNum As Long
Dim rowExtracted As Long
Dim WSF As WorksheetFunction
Range("A1:G1").Value = [{"RAND","コード","10台","修正RAND","Rank","修正Rank","採用Item"}]
Range("H1:O1").Value = [{"結果コード","抽出","10台","分類","採用数","品数","グループ","品名"}]
Range("M3").Value = "セット総数"
Set WSF = WorksheetFunction
If Range("M2").Value < 2 Or 6 < Range("M2").Value Then
MsgBox "M6セルに「2～6」の数値を入力してから実行してください"
Exit Sub
End If
Application.ScreenUpdating = False
Range("L2:L10").ClearContents
Range("G2:H91").ClearContents
Range("N2:O91").ClearContents
Range("I2:I8").ClearContents
Range("B2").Value = 10
Range("B2").AutoFill Destination:=Range("B2:B91"), Type:=xlFillSeries
Range("A2:A91").FormulaLocal = "=RAND()"
Range("A2:A91").Value = Range("A2:A91").Value '固定化
Range("C2:C91").FormulaLocal = "=FLOOR(B2,10)"
Range("D2:D91").FormulaLocal = "=IF(COUNTIF($J$2:$J$7,C2),"""",A2)"
Range("E2:E91").FormulaLocal = "=IF(D2="""","""",RANK(D2,D$2:D$91))"
Range("F2:F91").FormulaLocal = "=IF(OR(E2="""",G2=1),"""",LOOKUP(C2,$K$2:$L$10)*100+E2)"
Range("J2:J8").FormulaLocal = "=IF(I2="""","""",FLOOR(I2,10))"
Range("K2:K10").Value = [{10;20;30;40;50;60;70;80;90}]
Range("B2").AutoFill Destination:=Range("B2:B91"), Type:=xlFillSeries
Range("M4").FormulaR1C1Local = "=INT(90/R2C13)"
DTL = Range("L2:L10").Value
timesToTry = Range("M4").Value
For NN = 1 To timesToTry
Range("I2:I7").ClearContents
For KK = 1 To Range("M2").Value
Set cellToWrite = Range("I200").End(xlUp).Offset(1)
rowExtracted = WSF.Match(WSF.Min(Range("F2:F91")), Range("F2:F91"), 0) + 1
cellToWrite.Value = Cells(rowExtracted, "B")
Cells(rowExtracted, "G").Value = 1
idx = Int(cellToWrite.Value / 10)
DTL(idx, 1) = DTL(idx, 1) + 1
Next KK
Set cellToWrite2 = Range("H200").End(xlUp).Offset(1)
cellToWrite2.Resize(Range("M2").Value).Value = Range("I2:I7").Value
Range("L2:L10").Value = DTL
Next NN
Range("L2:L10").Value = DTL
Range("N2:N91").FormulaLocal = "=IF(H2="""","""",IF(MOD(ROW()-2,$M$2)=0,ROUNDUP(ROW()/$M$2,0),""""))"
Range("O2:O91").FormulaLocal = "=IF(H2="""","""",INDEX(品名リスト!$C$2:$L$10,INT(H2/10),MOD(H2,10)+1))"
Application.ScreenUpdating = True
End Sub
（半平太） 2015/05/21(木) 12:08
（やっちゃば） 2015/05/22(金) 08:57
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.