商品コード一覧表をエクセルＶＢＡで作成したいのです

質問

「商品コード一覧表」の作成を自動でしたいのです。

商品は６面の箱状のものです。（ルービックキューブみたいなものです。）

各面の色を自由に選択できるようになっています。

色は４種から選べるのですが、各面ごとに選べる色は異なっています。

たとえば・・・

６面をそれぞれＡ面、Ｂ面・・・Ｆ面として、色の選択方法は以下のようになります。

Ａ面はＡ１～Ａ４の４色から１つを選択

Ｂ面はＢ１～Ｂ４の４色から１つを選択

Ｃ面はＣ１～Ｃ４の４色から１つを選択
・
・
Ｆ面はＦ１～Ｆ４の４色から１つを選択

このようにＡ面からＦ面まで、１つずつ色を選択して商品コードを作成します。

作成する商品コードは色を６つ横に並べた形になります。

（例１）
「Ａ１Ｂ１Ｃ１Ｄ１Ｅ１Ｆ１」

（例２）
「Ａ１Ｂ２Ｃ１Ｄ３Ｅ４Ｆ２」

（例３）
「Ａ４Ｂ１Ｃ３Ｄ２Ｅ１Ｆ４」

商品コードのパターンは、各面４色ずつ選べるので、

４×４×４×４×４×４＝４０９６

となります。

全部でパターンは４０９６通りあるのですが、

商品として製造するのは、このうち４００～５００種になります。

全体からすると、約１割程度のパターンを使って製造するのですが、

抽出方法に決まりがある訳では無く、適当にランダムに選び出します。

４００個の商品コードを４００行のテキストデータにして、

商品コード一覧（１つのファイル）として作成し、保存する。

これまで、これらの作業をエクセルを使ってせっせと作成していました。

最近になって本屋でエクセルＶＢＡなるものを知り、自分でやろうと頑張ってみたのですが、

どうも、思うようなものを作ることができません。

ＶＢＡを使って自動でしたい内容は以下の点です。

１）作成する「商品コード一覧」の保存ファイル名を任意に設定できるようにする。
　・エクセルシートの（Ａ１）セルに任意に入力（手作業で）

２）色のコードはあらかじめセル（４種×６面で２４個のセル）に入力しておく（手作業で）
　・エクセルシートのＡ列に、たてに２４個を入力
　・セル（　Ａ３～　Ａ６）にＡ面の色コード
　・セル（　Ａ８～Ａ１１）にＢ面の色コード
　・セル（Ａ１３～Ａ１６）にＣ面の色コード
　・セル（Ａ１８～Ａ２１）にＤ面の色コード
　・セル（Ａ２３～Ａ２６）にＥ面の色コード
　・セル（Ａ２８～Ａ３１）にＦ面の色コード

３）作成する商品コードの「数」を指定する
　・基本的に４００ですが、任意の数値を指定できるようにする
　・作成する数を４００にしても５００にしても、どの色コードも平均的に使用するようにしたい

４）「商品コード一覧」をテキストデータで保存する
　※商品コードごとに改行する（４００個にした場合、４００行のテキストデータ）

５）テキストデータの形

　　　保存ファイル名,商品コード１
　　　保存ファイル名,商品コード２
　　　保存ファイル名,商品コード３
　　　保存ファイル名,商品コード４
　　　　・
　　　　・
　　　保存ファイル名,商品コード４００

　※各行の先頭には「保存ファイル名」←セル（Ａ１）に入力したもの
　　↑どの行にも同じ「保存ファイル名」を入れる

　※保存ファイル名を商品コードの間にカンマを入れる

以上、よろしくお願い申し上げます。

回答No.3

mt2008

あぁ、Excel2003だとあのマクロではソートの箇所でエラーになりますね。
今後は、Excelの質問の時はご使用のバージョンも明記してください。

ランダムに色コードを割り振るのと重複なしにするのではアプローチが異なるので作り直してみました。
Excel2003でも動くはずです。

Sub Sample2()
　　Dim ASide, BSide, CSide, DSide, ESide, FSide
　　nTotal = Range("B1") '←商品数（Sheet1のB1セル）
　　sFileName = Range("A1") '←ファイル名（Sheet1のA1セル）

　　'各面の色コードを配列に取り込む
　　ASide = Range("A3:A6")
　　BSide = Range("A8:A11")
　　CSide = Range("A13:A16")
　　DSide = Range("A18:A21")
　　ESide = Range("A23:A26")
　　FSide = Range("A28:A31")

　　Application.ScreenUpdating = False

　　With Sheets("Sheet2")
　　　　.Cells.ClearContents
　　　　For i = 0 To 4095
　　　　　　'全パターン作成
　　　　　　.Cells(i + 1, 1) = sFileName
　　　　　　aa = 1 + Int(i / 4 ^ 5) Mod 4
　　　　　　bb = 1 + Int(i / 4 ^ 4) Mod 4
　　　　　　cc = 1 + Int(i / 4 ^ 3) Mod 4
　　　　　　dd = 1 + Int(i / 4 ^ 2) Mod 4
　　　　　　ee = 1 + Int(i / 4 ^ 1) Mod 4
　　　　　　ff = 1 + Int(i / 4 ^ 0) Mod 4
　　　　　　.Cells(i + 1, 2) = ASide(aa, 1) & BSide(bb, 1) & CSide(cc, 1) & DSide(dd, 1) & ESide(ee, 1) & FSide(ff, 1)
　　　　　　.Cells(i + 1, 3) = Rnd()
　　　　Next i

　　　　'ランダムに並び替え
　　　　.Range("A1:C4096").Sort Key1:=.Range("C1")

　　　　'不要な分を削除
　　　　.Range("C1:C4096").ClearContents
　　　　.Range("A" & nTotal + 1 & ":B4096").ClearContents

　　　　'CSVで保存
　　　　.Copy
　　　　ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & sFileName, FileFormat:=xlCSV
　　　　ActiveWindow.Close (False)

　　　　Application.ScreenUpdating = True

　　End With
End Sub

お礼

ありがとうございます。
作業したい内容を完璧にこなしてくれました。
早速、会社で上司に報告して業務改善できたことを自慢しました。
大変お世話になりました。

先の上司が離れ際にぼそっと言いました。
「他の課に２４面の商品があるけど、それにも使えるかなあ・・・」と。
で、自分でやってみようとチャレンジしてみましたが。みごとに撃沈でした。

６面の場合は、４の６乗となり、４０９６パターンを全部作って並び替えているので、
簡単に、４の２４乗にすれば良いと考えましたが・・・

４の１２乗は2.81474977 × 10の14乗となり、エクセルの最大行65536を超えています。
そもそも、エクセルの最大行をオーバーするので、２４面なんて到底無理なんでしょうか。

回答No.2

mt2008

しょっぱなのコードが一つ間違っていましたね（お恥ずかしい）
誤：nTotal = Sheets("Sheet2").Range("B1")　　'←商品数
↓
正：nTotal = Sheets("Sheet1").Range("B1")　　'←商品数

でも、動かしてみたという事は、ここはご自分でクリアされたようですね。

> 早速、シート２のＢ列に出来た商品コードを確認してみると、残念ながら、重複していました。
> ソートしてみると４種類のコードしかありませんでした。
> １００個の同じ商品コードが４種類で、４００個できているようです。
> ４００個すべて異なるコードにすることは難しいのでしょうか。

すべて異なった商品コードにする事は求められていませんでしたのでランダムに並べています。ランダムなので4種類の商品コードしかできない可能性も0ではありませんが通常はありえないはずです。
並び替える辺りで転記ミスをされていませんか。
当方の環境（Excel2010）では400個の商品コードを作ると常に370～390種類の商品コードが作成されています。

お礼

迅速なご対応ありがとうございました。
しかし
・・・・ゴールまでたどり着いていません。

実行した後のエクセルのシート２の状況から、
素人ながら、以下のように考えています。

（その１）「６面分ランダムに並び替え」が実行されていないようです。

状況は、
エクセルのシート２のＣ、Ｅ、Ｇ、Ｉ、Ｋ、Ｍ列の数値を見てみると
ソート（昇順、降順）されずにそのままの状態（バラバラ）になっています。

（その２）「ファイル名と商品コードだけにする」が実行されていないようです。

状況は、
エクセルのシート２のＣ列より後ろの列がすべて表示されたままに
なっています。

（その３）「CSVで保存」が実行されていないようです。

状況は、
指定したファイル名のＣＳＶファイルが、どのフォルダにも見つかりません。

また、
エラー表示「オブジェクトは、このプロパティまたはメソッドをサポート
していません。」が出ます。

「追記」
当方のエクセルは2003です。
古いエクセルなので、実行できないのでしょうか。
また、
重複しない商品コードを作成するのは不可能なのでしょうか。

回答No.1

mt2008

Sheet1にカラーコード等が入力されているものとし、Sheet2を作業用シートとして使用します。
また、商品数はSheet1のB1セルに入力されているものとします。

Sub Sample()
　　nTotal = Sheets("Sheet2").Range("B1")　　'←商品数
　　With Sheets("Sheet2")
　　　　.Cells.ClearContents
　　　　.Range("A1:A4") = Sheets("Sheet1").Range("A1").Value 'ファイル名
　　　　.Range("B1:B4").FormulaR1C1 = "=RC[2]&RC[4]&RC[6]&RC[8]&RC[10]&RC[12]" '商品コード
　　　　.Range("C1:N4").Formula = "=RAND()" 'ソート用乱数

　　　　'色コードをコピー
　　　　For i = 1 To 6
　　　　　　.Range(.Cells(1, i * 2 + 2), .Cells(4, i * 2 + 2)) = Sheets("Sheet1").Range("A" & (i * 5 - 2) & ":A" & (i * 5 + 1)).Value
　　　　Next i
　　　　'商品数分コピー
　　　　.Range("A1:N4").AutoFill Destination:=.Range("A1:N" & nTotal), Type:=xlFillCopy

　　　　'６面分ランダムに並び替え
　　　　For i = 1 To 6
　　　　　　.Sort.SortFields.Clear
　　　　　　.Sort.SortFields.Add Key:=.Cells(1, i * 2 + 1)
　　　　　　.Sort.SetRange .Range(.Cells(1, i * 2 + 1), .Cells(nTotal, i * 2 + 2))
　　　　　　.Sort.Header = xlGuess
　　　　　　.Sort.MatchCase = False
　　　　　　.Sort.Orientation = xlTopToBottom
　　　　　　.Sort.SortMethod = xlPinYin
　　　　　　.Sort.Apply
　　　　Next i

　　　　'ファイル名と商品コードだけにする
　　　　.Range("A1:B" & nTotal) = .Range("A1:B" & nTotal).Value
　　　　.Columns("C:N").ClearContents

　　　　'CSVで保存
　　　　.Copy
　　　　ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & .Range("A1"), FileFormat:=xlCSV
　　　　ActiveWindow.Close (False)
　　End With
End Sub

上記のコードの内容が理解できなくても良いですが、業務で使うのでしたら、最低でもステップ実行して、どこでどんなことをやっているのか確認してから使ってください。

お礼

自分ではどうしても無理であきらめていました。
どうにか先が見えてきました。
大変ありがとうございました。

補足

大変ありがとうございます。早速、試させていただきました。
シート２のＢ１に４００と入力して実行すると、見事に４００個の商品コードができ、感動しました。
早速、シート２のＢ列に出来た商品コードを確認してみると、残念ながら、重複していました。
ソートしてみると４種類のコードしかありませんでした。
１００個の同じ商品コードが４種類で、４００個できているようです。
４００個すべて異なるコードにすることは難しいのでしょうか。