1214670644 エクセルのマクロの質問です。商品情報が記載されたCSVファイルをエクセルで添付画像のサンプルのように商品番号、商品名を変更したいと考えています。

バーコードで管理するため、今までの商品番号にカラー、サイズの要素を入れるためです。
手作業で行うと1万近くになり、ミスが生じやすくなります。
そこでできればマクロで解決したいと思います。
マクロの知識が浅いため、解決方法そのものを教えていただければうれしいです。もしそのまま使える完全なコードややり方を回答していただいた回答者の方には500ポイントを差し上げます。よろしくお願いいたします。
※文字制限のためサンプルデータ、仕様の詳細はこの下にある「この質問・回答へのコメント」に記載いたします。

回答の条件
  • 1人5回まで
  • 登録:2008/06/29 01:30:47
  • 終了:2008/07/04 18:01:39

ベストアンサー

id:Mook No.2

Mook回答回数1312ベストアンサー獲得回数3912008/06/29 12:40:07

ポイント1500pt

修正しました。


先のもバグがありました。

大変申し訳ありません。

関数名の中で返す値が関数名と異なるため、すべて偽となっていました。


今回の仕様の変更上、オプションチェックは外しましたが、オプションの書式の確認が必要でしたら

コメントください。

対策を考えます。

Option Explicit

'------------------------------------------------------------------------
Sub RemakeItemCode()
'------------------------------------------------------------------------
    Dim lastRow As Long
    lastRow = Range("A" & Rows.Count).End(xlUp).Row

    Dim srcWS As Worksheet
    Set srcWS = ActiveSheet
    
'--- 結果を出力用に先頭に対象シートをコピー
    srcWS.Copy before:=Worksheets(1)
    
    Dim dstWS As Worksheet
    Set dstWS = Worksheets(1)
    
    dstWS.Range("A2:Z" & lastRow).Value = ""
    Dim cArray, sArray
    Dim srcRow As Long, dstRow As Long, ci As Long, si As Long
    Dim pCode As String, pName As String
    dstRow = 2
    For srcRow = 2 To lastRow
        cArray = Split(srcWS.Cells(srcRow, "G").Value & ":", ":")
        sArray = Split(srcWS.Cells(srcRow, "H").Value & ":", ":")
        For ci = LBound(cArray) To UBound(cArray)
            For si = LBound(sArray) To UBound(sArray)
                If makeItemInfo(pName, pCode, cArray(ci), sArray(si)) = True Then
                    srcWS.Rows(srcRow).Copy Destination:=dstWS.Rows(dstRow)
                    dstWS.Cells(dstRow, "B").Value = srcWS.Cells(srcRow, "B").Value & pName
                    dstWS.Cells(dstRow, "C").Value = srcWS.Cells(srcRow, "C").Value & pCode
                    dstRow = dstRow + 1
                End If
            Next
        Next
    Next
End Sub

'------------------------------------------------------------------------
' 商品名と商品コードの情報を作成
'------------------------------------------------------------------------
Function makeItemInfo(ByRef pName, ByRef pCode, cOpt, sOpt) As Boolean
'------------------------------------------------------------------------
    Dim cArray, sArray
    cArray = Split(cOpt, "=")
    sArray = Split(sOpt, "=")
    If UBound(cArray) >= 1 And UBound(sArray) >= 1 Then
'--- ワンサイズの文字があるか判断
        If InStr(sOpt, "ワンサイズ") = 0 Then
            pName = "/" & cArray(1) & "/" & sArray(1)
            pCode = cArray(0) & sArray(0)
        Else
            pName = "/" & cArray(1)
            pCode = cArray(0) & sArray(0)
        End If
        makeItemInfo = True
    Else
        makeItemInfo = False
    End If
End Function

その他の回答(1件)

id:Mook No.1

Mook回答回数1312ベストアンサー獲得回数3912008/06/29 02:57:09

一応ご希望の仕様に沿って作ってみました。

ただし、処理のしやすさから元のシートを変更するのではなく、先頭に結果のシートを出力しています。


元のシートを表示した状態で、実行してください。

Option Explicit

'------------------------------------------------------------------------
Sub RemakeItemCode()
'------------------------------------------------------------------------
    Dim lastRow As Long
    lastRow = Range("A" & Rows.Count).End(xlUp).Row

    Dim srcWS As Worksheet
    Set srcWS = ActiveSheet
    
'--- 結果を出力用に先頭に対象シートをコピー
    srcWS.Copy before:=Worksheets(1)
    
    Dim dstWS As Worksheet
    Set dstWS = Worksheets(1)
    
    dstWS.Range("A2:Z" & lastRow).Value = ""
    Dim cArray, sArray
    Dim srcRow As Long, dstRow As Long, ci As Long, si As Long
    Dim pCode As String, pName As String
    dstRow = 2
    For srcRow = 2 To lastRow
        cArray = Split(srcWS.Cells(srcRow, "G").Value, ":")
        sArray = Split(srcWS.Cells(srcRow, "H").Value, ":")
        For ci = LBound(cArray) To UBound(cArray)
            For si = LBound(sArray) To UBound(sArray)
                srcWS.Rows(srcRow).Copy Destination:=dstWS.Rows(dstRow)
                If makeItemInfo(pName, pCode, cArray(ci), sArray(si)) = False Then
                    '--- オプション情報が不足していた場合、列を赤で表示
                    dstWS.Range("A" & dstRow).Resize(1, 10).Interior.ColorIndex = 3
                End If
                dstWS.Cells(dstRow, "B").Value = srcWS.Cells(srcRow, "B").Value & pName
                dstWS.Cells(dstRow, "C").Value = srcWS.Cells(srcRow, "C").Value & pCode
                dstRow = dstRow + 1
            Next
        Next
    Next
End Sub

'------------------------------------------------------------------------
' 商品名と商品コードの情報を作成
'------------------------------------------------------------------------
Function makeItemInfo(ByRef pName, ByRef pCode, cOpt, sOpt) As Boolean
'------------------------------------------------------------------------
    Dim cArray, sArray
    cArray = Split(cOpt, "=")
    sArray = Split(sOpt, "=")
    If UBound(cArray) >= 2 And UBound(sArray) >= 2 Then
'--- ワンサイズの文字があるか判断
        If InStr(sOpt, "ワンサイズ") = 0 Then
            pName = "/" & cArray(1) & "/" & sArray(1)
            pCode = cArray(0) & sArray(0)
        Else
            pName = "/" & cArray(1)
            pCode = cArray(0) & sArray(0)
        End If
        makeDstInfo = True
    Else
        pName = ""
        pCode = ""
        makeDstInfo = False
    End If
End Function
id:Mook No.2

Mook回答回数1312ベストアンサー獲得回数3912008/06/29 12:40:07ここでベストアンサー

ポイント1500pt

修正しました。


先のもバグがありました。

大変申し訳ありません。

関数名の中で返す値が関数名と異なるため、すべて偽となっていました。


今回の仕様の変更上、オプションチェックは外しましたが、オプションの書式の確認が必要でしたら

コメントください。

対策を考えます。

Option Explicit

'------------------------------------------------------------------------
Sub RemakeItemCode()
'------------------------------------------------------------------------
    Dim lastRow As Long
    lastRow = Range("A" & Rows.Count).End(xlUp).Row

    Dim srcWS As Worksheet
    Set srcWS = ActiveSheet
    
'--- 結果を出力用に先頭に対象シートをコピー
    srcWS.Copy before:=Worksheets(1)
    
    Dim dstWS As Worksheet
    Set dstWS = Worksheets(1)
    
    dstWS.Range("A2:Z" & lastRow).Value = ""
    Dim cArray, sArray
    Dim srcRow As Long, dstRow As Long, ci As Long, si As Long
    Dim pCode As String, pName As String
    dstRow = 2
    For srcRow = 2 To lastRow
        cArray = Split(srcWS.Cells(srcRow, "G").Value & ":", ":")
        sArray = Split(srcWS.Cells(srcRow, "H").Value & ":", ":")
        For ci = LBound(cArray) To UBound(cArray)
            For si = LBound(sArray) To UBound(sArray)
                If makeItemInfo(pName, pCode, cArray(ci), sArray(si)) = True Then
                    srcWS.Rows(srcRow).Copy Destination:=dstWS.Rows(dstRow)
                    dstWS.Cells(dstRow, "B").Value = srcWS.Cells(srcRow, "B").Value & pName
                    dstWS.Cells(dstRow, "C").Value = srcWS.Cells(srcRow, "C").Value & pCode
                    dstRow = dstRow + 1
                End If
            Next
        Next
    Next
End Sub

'------------------------------------------------------------------------
' 商品名と商品コードの情報を作成
'------------------------------------------------------------------------
Function makeItemInfo(ByRef pName, ByRef pCode, cOpt, sOpt) As Boolean
'------------------------------------------------------------------------
    Dim cArray, sArray
    cArray = Split(cOpt, "=")
    sArray = Split(sOpt, "=")
    If UBound(cArray) >= 1 And UBound(sArray) >= 1 Then
'--- ワンサイズの文字があるか判断
        If InStr(sOpt, "ワンサイズ") = 0 Then
            pName = "/" & cArray(1) & "/" & sArray(1)
            pCode = cArray(0) & sArray(0)
        Else
            pName = "/" & cArray(1)
            pCode = cArray(0) & sArray(0)
        End If
        makeItemInfo = True
    Else
        makeItemInfo = False
    End If
End Function
  • id:icta
    お知恵とお力をお借りできれば幸いです。
    仕様で何かご不明な点ありましたらお知らせください。


    ■マクロの仕様

    ○概要
    ・2行目から始めA列の"商品番号"のセルに値がなくなるまでマクロを実行し続ける。
    ・G列の"オプション1"には"="を区切り記号として色記号、色名、在庫数が入っている。":"は色が複数ある場合の区切り記号である。
    ・H列の"オプション2"には"="を区切り記号としてサイズ記号、サイズが入っている。":"はサイズが複数ある場合の区切り記号である。
    ・G列の"オプション1"の色数×H列の"オプション2"のサイズ数=商品の行数 
     例:カラー2色、サイズ2種なら計4行
    ・G列の"オプション1"とH列の"オプション2"を色、サイズごとに分解しておく。
     例:PK パープル/BK ブラック、1 1/2 2
    ・行ごとコピーし、コピーした行の下に商品行数-1行を挿入する。※画像参照
     例:4行なら3行挿入。
    ・商品名に"/"区切りで色名、サイズを加える。ただしワンサイズと表記されているものは場合は商品名にサイズを加えない。
     例:チュニック/パープル/1、ワンピース/パープル ※ワンピース/パープル/ワンサイズとしない。
    ・商品記号に色記号、サイズ記号を加える。
     例:IL070802PR1、IL030904BK0
    ・"商品の行数"が終わるまで繰り返す。
    ・次の商品の行に移る


    ■サンプルデータ(半角スペース区切り)

    ○マクロ実行前

    商品番号 商品名 商品記号 その他1 その他2 分類 オプション1 オプション2 説明 販売価格
    12 チュニック IL070802 2005/11/21 1 PR=パープル=0=:BK=ブラック=0= 1=1=:2=2= ||||05春夏コ 18800
    14 ワンピース IL030904 2005/11/21 1 PR=パープル=0=:BK=ブラック=0= 0=ワンサイズ= ||||05春夏コ 19800

    ○マクロ実行後

    商品番号 商品名 商品記号 その他1 その他2 分類 オプション1 オプション2 説明 販売価格
    12 チュニック/パープル/1 IL070802PR1 2005/11/21 1 PR=パープル=0=:BK=ブラック=0= 1=1=:2=2= ||||05春夏コ・・・ 18800
    12 チュニック/パープル/2 IL070802PR2 2005/11/21 1 PR=パープル=0=:BK=ブラック=0= 1=1=:2=2= ||||05春夏コ・・・ 18800
    12 チュニック/ブラック/1 IL070802BK1 2005/11/21 1 PR=パープル=0=:BK=ブラック=0= 1=1=:2=2= ||||05春夏コ・・・ 18800
    12 チュニック/ブラック/2 IL070802BK2 2005/11/21 1 PR=パープル=0=:BK=ブラック=0= 1=1=:2=2= ||||05春夏コ・・・ 18800
    14 ワンピース/パープル IL030904PR0 2005/11/21 1 PR=パープル=0=:BK=ブラック=0= 0=ワンサイズ= ||||05春夏コ・・・ 19800
    14 ワンピース/ブラック IL030904BK0 2005/11/21 1 PR=パープル=0=:BK=ブラック=0= 0=ワンサイズ= ||||05春夏コ・・・ 19800
  • id:BANO
    1万近くになるのであれば、エクセルでマクロを使うよりもDBのほうが効率的に思いますが、アクセスやDBを利用することはできない前提ですか?
    エクセルでデータがあがってきたのをアクセスに取り込めばクエリだけで問題なく処理が完了すると思うのですが・・・
  • id:icta
    > Mookさん
    早々のご回答ありがとうございました。
    大変申し訳ありません。
    最初の前提部分で間違いがありました。
    データに複数の記述が方法が存在していました。
    そこで記述を以下の方法に統一したいと思います。
    お手数をおかけして申し訳ありませんが、修正お願いできれば幸いです。

    オプション1、オプション2ともに、データが1つまたは最後のデータには区切り記号の":"はつかない。
     例:DM=デニム=1=、0=ワンサイズ、PR=パープル=0=:BK=ブラック=0=

    ○マクロ実行前

    商品番号 商品名 商品記号 その他1 その他2 分類 オプション1 オプション2 説明 販売価格
    12 チュニック IL070802 2005/11/21 1 PR=パープル=0=:BK=ブラック=0= 1=1:2=2 ||||05春夏コ・・・ 18800
    14 ワンピース IL030904 2005/11/21 1 PR=パープル=0=:BK=ブラック=0= 0=ワンサイズ ||||05春夏コ・・・ 19800
    15 スカート GL030104 2005/11/22 1 DM=デニム=1= 0=ワンサイズ ||||デニムの・・・ 19800


    ○マクロ実行後

    商品番号 商品名 商品記号 その他1 その他2 分類 オプション1 オプション2 説明 販売価格
    12 チュニック/パープル/1 IL070802PR1 2005/11/21 1 PR=パープル=0=:BK=ブラック=0= 1=1:2=2 ||||05春夏コ・・・ 18800
    12 チュニック/パープル/2 IL070802PR2 2005/11/21 1 PR=パープル=0=:BK=ブラック=0= 1=1:2=2 ||||05春夏コ・・・ 18800
    12 チュニック/ブラック/1 IL070802BK1 2005/11/21 1 PR=パープル=0=:BK=ブラック=0= 1=1:2=2 ||||05春夏コ・・・ 18800
    12 チュニック/ブラック/2 IL070802BK2 2005/11/21 1 PR=パープル=0=:BK=ブラック=0= 1=1:2=2 ||||05春夏コ・・・ 18800
    14 ワンピース/パープル IL030904PR0 2005/11/21 1 PR=パープル=0=:BK=ブラック=0= 0=ワンサイズ ||||05春夏コ・・・ 19800
    14 ワンピース/ブラック IL030904BK0 2005/11/21 1 PR=パープル=0=:BK=ブラック=0= 0=ワンサイズ ||||05春夏コ・・・ 19800
    15 スカート/デニム GL030104DM0 2005/11/22 1 DM=デニム=1= 0=ワンサイズ ||||デニムの・・・ 19800

    >BANOさん
    >アクセスやDBを利用することはできない前提ですか?
    はい、上記は利用しない前提です。過去の質問をご覧いただければ幸いです。
  • id:icta
    > Mookさん
    早々の修正ありがとうございました。
    完全に希望通りの動作を確認しました。
    このマクロのおかげで短時間で正確なデータを作ることができそうです。

    これまでの経験上、実際に運用を始めて少し経たないと変更/修正箇所等が見えてきません。
    そのためいったん回答の受付を一時停止し、来週の7/5土曜日に改めてご報告いたします。
    今回のマクロの性質上、修正/変更箇所などはないとは思いますが、質問を終了するのをもうしばらくお待ちいただけますでしょうか?
    勝手な都合で申し訳ありませんがよろしくお願いいたします。
  • id:Mook
    動いたようでなによりです。

    不具合ありましたら、コメントください。

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません