こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

締切り済みの質問

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

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

商品は6面の箱状のものです。(ルービックキューブみたいなものです。)

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

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

たとえば・・・

6面をそれぞれA面、B面・・・F面として、色の選択方法は以下のようになります。

A面はA1~A4の4色から1つを選択

B面はB1~B4の4色から1つを選択

C面はC1~C4の4色から1つを選択


F面はF1~F4の4色から1つを選択


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

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

(例1)
「A1B1C1D1E1F1」

(例2)
「A1B2C1D3E4F2」

(例3)
「A4B1C3D2E1F4」


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

4×4×4×4×4×4=4096

となります。


全部でパターンは4096通りあるのですが、

商品として製造するのは、このうち400~500種になります。


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

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


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

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

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


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

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


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

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

2)色のコードはあらかじめセル(4種×6面で24個のセル)に入力しておく(手作業で)
 ・エクセルシートのA列に、たてに24個を入力
 ・セル( A3~ A6)にA面の色コード
 ・セル( A8~A11)にB面の色コード
 ・セル(A13~A16)にC面の色コード
 ・セル(A18~A21)にD面の色コード
 ・セル(A23~A26)にE面の色コード
 ・セル(A28~A31)にF面の色コード

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

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

5)テキストデータの形

   保存ファイル名,商品コード1
   保存ファイル名,商品コード2
   保存ファイル名,商品コード3
   保存ファイル名,商品コード4
    ・
    ・
   保存ファイル名,商品コード400


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

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


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

投稿日時 - 2012-07-08 11:33:45

QNo.7578507

困ってます

このQ&Aは役に立ちましたか?

1人が「このQ&Aが役に立った」と投票しています

回答(3)

ANo.3

あぁ、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

投稿日時 - 2012-07-11 17:30:14

お礼

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

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

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

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

投稿日時 - 2012-07-17 23:35:15

ANo.2

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

正:nTotal = Sheets("Sheet1").Range("B1")  '←商品数

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


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

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

投稿日時 - 2012-07-10 01:11:18

お礼

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

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


(その1)「6面分ランダムに並び替え」が実行されていないようです。

状況は、
エクセルのシート2のC、E、G、I、K、M列の数値を見てみると
ソート(昇順、降順)されずにそのままの状態(バラバラ)になっています。



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

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



(その3)「CSVで保存」が実行されていないようです。

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


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


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

投稿日時 - 2012-07-10 23:03:22

ANo.1

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
    
    '6面分ランダムに並び替え
    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


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

投稿日時 - 2012-07-09 13:05:41

補足

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

投稿日時 - 2012-07-10 00:20:10

お礼

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

投稿日時 - 2012-07-10 00:24:49

あなたにオススメの質問