エクセルのマクロの質問です。来店客の購入履歴を「来店記録」、商品番号と商品名のリストを「商品リスト」、在庫を「在庫管理リスト」というファイルに記録しています。各々のファイルが関連付けられていないので商品管理に役立っていません。これをバーコードリーダーとマクロによって作業の簡略化、データの有効活用を行いたいと考えています。

購入された商品はエクセルにバーコードリーダーで商品番号を取込みます。
商品番号は1セルに1つだけ入り、右側のセルに次の商品番号が入ります。これを1つのセルにカンマ区切りで収め、対応する商品名を「商品リスト」から参照し、同じようにセルに収めるにはどうすればよいでしょうか?
マクロの知識が浅いため、解決方法そのものを教えていただければうれしいです。もしそのまま使える完全なコードややり方を回答していただいた回答者の方には500ポイントを差し上げます。よろしくお願いいたします。
※文字制限のため「来店記録」、「商品リスト」のサンプルデータ、仕様の詳細はこの下にある「この質問・回答へのコメント」に記載いたします。

回答の条件
  • 1人5回まで
  • 登録:2008/05/15 23:10:26
  • 終了:2008/05/16 14:48:30

ベストアンサー

id:SALINGER No.3

SALINGER回答回数3454ベストアンサー獲得回数9692008/05/16 14:31:21

ポイント500pt
Sub Macro()
    Dim i As Integer
    Dim j As Long
    Dim k As Integer
    Dim l As Integer
    Dim sName As String
    Dim sNum As String
    Dim retu() As Integer
    Dim f As Boolean
    Dim rr As Integer
    Dim r As Range
    Dim sList As String
    
    With Worksheets("来店記録")
        '列に挿入されたることを考えて商品番号が何列目かを調べます
        i = 1
        While .Cells(1, i).Value <> "商品番号"
            i = i + 1
        Wend
        
        ReDim retu(0) As Integer
        For Each r In Selection
            rr = r.Row
            f = False
            For l = 0 To UBound(retu)
                If retu(l) = rr Then
                    f = True
                    Exit For
                End If
            Next l
            If f = False Then
                sName = ""
                sNum = ""
                k = i
                While .Cells(rr, k).Value <> ""
                    j = 2
                    While Worksheets("商品リスト").Cells(j, 2).Value <> .Cells(rr, k).Value And _
                        Worksheets("商品リスト").Cells(j, 2).Value <> ""
                        j = j + 1
                    Wend
                    
                    sList = Worksheets("商品リスト").Cells(j, 3).Value
                    If sList = "" Then
                        sList = "存在しない商品番号"
                    End If
                    
                    If sName = "" Then
                        sName = sList
                    Else
                        sName = sName & "," & sList
                    End If
                    If sNum = "" Then
                        sNum = .Cells(rr, k).Value
                    Else
                        sNum = sNum & "," & .Cells(rr, k).Value
                    End If
                    .Cells(rr, k).Value = ""
                    k = k + 1
                Wend
                
                .Cells(rr, i - 1).Value = sName
                .Cells(rr, i).Value = sNum
                
                ReDim Preserve retu(UBound(retu) + 1) As Integer
                retu(UBound(retu)) = rr
            End If
        Next r
    End With
End Sub
id:icta

早々のご回答ありがとうございました。

希望通りの動作を確認いたしました。

これでかなり作業を軽減することができます。

本当にありがとうございました。

2008/05/16 14:47:22

その他の回答(2件)

id:SALINGER No.1

SALINGER回答回数3454ベストアンサー獲得回数9692008/05/16 01:04:05

3)の部分のマクロを作りました。

ドラッグというのは、セルを移動させたりするときにつかむ動作を指すので、この場合は選択になるんじゃないかと思います。

それで商品番号の入力されている行を選択状態にしてマクロを実行してください。

(商品番号のセルを選択しても同じ動作をします。)

Sub Macro()
    Dim i As Integer
    Dim j As Long
    Dim k As Integer
    Dim sName As String
    Dim sNum As String
    
    With Worksheets("来店記録")
        '列に挿入されたることを考えて商品番号が何列目かを調べます
        i = 1
        While .Cells(1, i).Value <> "商品番号"
            i = i + 1
        Wend
        
        k = i
        While .Cells(Selection.Row, k).Value <> ""
            j = 2
            While Worksheets("商品リスト").Cells(j, 2).Value <> .Cells(Selection.Row, k).Value And _
                Worksheets("商品リスト").Cells(j, 2).Value <> ""
                j = j + 1
            Wend
            If sName = "" Then
                sName = Worksheets("商品リスト").Cells(j, 3).Value
            Else
                sName = sName & "," & Worksheets("商品リスト").Cells(j, 3).Value
            End If
            If sNum = "" Then
                sNum = .Cells(Selection.Row, k).Value
            Else
                sNum = sNum & "," & .Cells(Selection.Row, k).Value
            End If
            .Cells(Selection.Row, k).Value = ""
            k = k + 1
        Wend
        
        .Cells(Selection.Row, i - 1).Value = sName
        .Cells(Selection.Row, i).Value = sNum
    End With
End Sub
id:icta

> SALINGERさん

早々のご回答ありがとうございます。「ドラッグ」の件、失礼いたしました。誤って覚えていました。

早速、マクロを実行してみたところほぼ希望通りの動作なのですが一点だけうまくいかないところがあります。

▼このような複数の行ができあがっているときにA081401からC080201を選択して実行すると最初の1行目だけしかカンマ区切りに変換されないのです。

A081401 A081401  

A081401 A081401 A081401 A081401

A081401 A081401 A081401 

A081401 A081401  

A081401 A081401  

A081301 AL071702  

A081301 AL071702  

C080201 G080501 G080202 

レジをしめたときにバーコードリーダーで顧客別にまとめて入力するため1列目のA081401からC080201を選択してマクロを実行したいと思います。

お手数をおかけしますが一度検証していただけますでしょうか。よろしくお願いいたします。

なお別件ですがhttp://q.hatena.ne.jp/1210901281へこの質問の派生質問を投稿しました。

こちらもお時間のあるときにご覧いただければ幸いです。

2008/05/16 11:27:53
id:SALINGER No.2

SALINGER回答回数3454ベストアンサー獲得回数9692008/05/16 13:37:48

失礼しました。1行にしか対応していませんでしたね。

複数選択に対応するように修正しました。

Sub Macro()
    Dim i As Integer
    Dim j As Long
    Dim k As Integer
    Dim l As Integer
    Dim sName As String
    Dim sNum As String
    Dim retu() As Integer
    Dim f As Boolean
    Dim rr As Integer
    Dim r As Range
    
    With Worksheets("来店記録")
        '列に挿入されたることを考えて商品番号が何列目かを調べます
        i = 1
        While .Cells(1, i).Value <> "商品番号"
            i = i + 1
        Wend
        
        ReDim retu(0) As Integer
        For Each r In Selection
            rr = r.Row
            f = False
            For l = 0 To UBound(retu)
                If retu(l) = rr Then
                    f = True
                    Exit For
                End If
            Next l
            If f = False Then
                sName = ""
                sNum = ""
                k = i
                While .Cells(rr, k).Value <> ""
                    j = 2
                    While Worksheets("商品リスト").Cells(j, 2).Value <> .Cells(rr, k).Value And _
                        Worksheets("商品リスト").Cells(j, 2).Value <> ""
                        j = j + 1
                    Wend
                    If sName = "" Then
                        sName = Worksheets("商品リスト").Cells(j, 3).Value
                    Else
                        sName = sName & "," & Worksheets("商品リスト").Cells(j, 3).Value
                    End If
                    If sNum = "" Then
                        sNum = .Cells(rr, k).Value
                    Else
                        sNum = sNum & "," & .Cells(rr, k).Value
                    End If
                    .Cells(rr, k).Value = ""
                    k = k + 1
                Wend
                
                .Cells(rr, i - 1).Value = sName
                .Cells(rr, i).Value = sNum
                
                ReDim Preserve retu(UBound(retu) + 1) As Integer
                retu(UBound(retu)) = rr
            End If
        Next r
    End With
End Sub
id:icta

> SALINGERさん

早々の修正ありがとうございました。

完全に希望通りの動作を確認し、大変うれしく思います。

実際に作業してみて判ったのです、このマクロにあと1点だけ機能を追加していただけませんでしょうか?

それは商品番号列に記載された商品番号が商品リストから見つけられないとき、空白の代わりに「存在しない商品番号」と商品名欄に記載するというものです。

商品番号の降り違い、手作業などによってこうしたケースが頻繁にあるものと思われます。

何度もお手間を取らせて申し訳ありませんがお力添えいただければ幸いです。

○実際の運用

1)G080701を選択してマクロを実行

__ G080701 A080607 F080710

2)F080710は商品リストにない商品番号なので「存在しない商品番号」と記載する

PPバッグ,OOキャミ2,存在しない商品番号 G080701,A080607,F080710

2008/05/16 14:08:14
id:SALINGER No.3

SALINGER回答回数3454ベストアンサー獲得回数9692008/05/16 14:31:21ここでベストアンサー

ポイント500pt
Sub Macro()
    Dim i As Integer
    Dim j As Long
    Dim k As Integer
    Dim l As Integer
    Dim sName As String
    Dim sNum As String
    Dim retu() As Integer
    Dim f As Boolean
    Dim rr As Integer
    Dim r As Range
    Dim sList As String
    
    With Worksheets("来店記録")
        '列に挿入されたることを考えて商品番号が何列目かを調べます
        i = 1
        While .Cells(1, i).Value <> "商品番号"
            i = i + 1
        Wend
        
        ReDim retu(0) As Integer
        For Each r In Selection
            rr = r.Row
            f = False
            For l = 0 To UBound(retu)
                If retu(l) = rr Then
                    f = True
                    Exit For
                End If
            Next l
            If f = False Then
                sName = ""
                sNum = ""
                k = i
                While .Cells(rr, k).Value <> ""
                    j = 2
                    While Worksheets("商品リスト").Cells(j, 2).Value <> .Cells(rr, k).Value And _
                        Worksheets("商品リスト").Cells(j, 2).Value <> ""
                        j = j + 1
                    Wend
                    
                    sList = Worksheets("商品リスト").Cells(j, 3).Value
                    If sList = "" Then
                        sList = "存在しない商品番号"
                    End If
                    
                    If sName = "" Then
                        sName = sList
                    Else
                        sName = sName & "," & sList
                    End If
                    If sNum = "" Then
                        sNum = .Cells(rr, k).Value
                    Else
                        sNum = sNum & "," & .Cells(rr, k).Value
                    End If
                    .Cells(rr, k).Value = ""
                    k = k + 1
                Wend
                
                .Cells(rr, i - 1).Value = sName
                .Cells(rr, i).Value = sNum
                
                ReDim Preserve retu(UBound(retu) + 1) As Integer
                retu(UBound(retu)) = rr
            End If
        Next r
    End With
End Sub
id:icta

早々のご回答ありがとうございました。

希望通りの動作を確認いたしました。

これでかなり作業を軽減することができます。

本当にありがとうございました。

2008/05/16 14:47:22
  • id:icta
    これはhttp://q.hatena.ne.jp/1210836514の派生質問です。
    データを記録するのはエクセルの知識がほとんどない販売スタッフです。データベースソフトを使えればよいのですが以前導入に失敗しました。現行作業をあまり変えることなく行うのが今回の方針です。


    「来店記録」

    店舗 会員番号 旧会員番号 会員資格 名前 フリガナ 来店日 担当 売上 商品名 商品番号
    新宿 D00572 D572 正 春丘 ハルオカ 2008/5/10 長岡 20000 XXカットソー,VVパンツM,IITシャツ A080102,D070604,A080201
    新宿 D00396 D396 正 服部 ハットリ 2008/5/10 長岡 5000 GGショール F080203
    原宿 D00645 D645 正 坂下 サカシタ 2008/5/10 佐藤 10000 JJジャケット3,EEパンツ2 C080402,D080601
    原宿 L00239 L239 正 杉本 スギモト 2008/5/10 佐藤 4000 OOキャミ2 A080607
    上野 D00146 D146 仮 落合 オチアイ 2008/5/11 長岡 8000 PPバッグ G080701
    上野 C00148 0148 仮 脇永 ワキナガ 2008/5/11 長岡 9000 ZZサンダル F080706
    上野 C01329 1329 正 川畑 カワハタ 2008/5/11 吉田 15000 LLリング,UUネックレス H080701,H080601
    上野 D00638 D638 正 長浜 ナガハマ 2008/5/11 吉田 6000 RRストール赤 J080703


    「商品リスト」

    カテゴリ 商品番号 商品名
    トップス A080102 XXカットソー
    トップス A080201 IITシャツ
    トップス A080607 OOキャミ2
    ジャケット C080402 JJジャケット3
    ボトムス D070604 VVパンツM
    ボトムス D080601 EEパンツ2
    ショール F080203 GGショール
    フットウェア F080706 ZZサンダル
    バッグ G080701 PPバッグ
    アクセサリー H080601 UUネックレス
    アクセサリー H080701 LLリング
    雑貨 J080703 RRストール赤


    ■仕様

    ○概要
    「来店記録」の商品番号が入力された商品番号列のセルをドラッグ。マクロを実行することによって商品番号に対応する商品名を「商品リスト」から呼び出し、商品番号と商品名をそれぞれ商品番号列と商品名列のセルにカンマ区切りで入力する。

    ○詳細
    「来店記録」の商品番号は1人の顧客に対し商品番号列を起点として右隣に順番に1つのセルに1つの商品番号が入力される。もし顧客が5人いたら5行、一人の顧客が5点購入すれば商品番号列から右に5列伸びる。
    商品番号が入力された商品番号列を顧客が5人いれば5行分をドラッグしてマクロを実行する。
    商品番号が入力された最終列を調べ、そこに達するまでの商品番号をカンマ区切りでドラッグした商品番号列に入力する。
    入力が終わったら商品番号列以外に入力された商品番号を削除する。
    カンマ区切りの商品番号を「商品リスト」から参照し、商品名を商品番号の左隣に同じようにカンマ区切りで入力する。


    ○実際の運用
    1)「来店記録」の商品番号列にカーソルを置く※□の位置
    店舗 会員番号 旧会員番号 会員資格 名前 フリガナ 来店日 担当 売上 商品名 商品番号
    新宿 C03827 3827 正 望月 モチヅキ 2008/5/12 佐藤 20000 __ □

    2)バーコードリーダーで商品番号を取り込む
    店舗 会員番号 旧会員番号 会員資格 名前 フリガナ 来店日 担当 売上 商品名 商品番号
    新宿 C03827 3827 正 望月 モチヅキ 2008/5/12 佐藤 21000 __ G080701 A080607 F080706
    新宿 T03830 3830 仮 吉本 ヨシモト 2008/5/12 佐藤 5000 __ F080203
    新宿 C03826 3826 正 藤下 フジシタ 2008/5/12 佐藤 5000 __ J080703 F080203

    3)商品番号の入力されている行をドラッグしてマクロを実行※G080701、F080203、J080703をドラッグ
    店舗 会員番号 旧会員番号 会員資格 名前 フリガナ 来店日 担当 売上 商品名 商品番号
    新宿 C03827 3827 正 望月 モチヅキ 2008/5/12 佐藤 21000 PPバッグ,OOキャミ2,ZZサンダル G080701,A080607,F080706
    新宿 T03830 3830 仮 吉本 ヨシモト 2008/5/12 佐藤 5000 GGショール F080203
    新宿 C03826 3826 正 藤下 フジシタ 2008/5/12 佐藤 5000 RRストール赤,GGショール J080703,F080203

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

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

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

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