人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

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

●質問者: icta
●カテゴリ:はてなの使い方 コンピュータ
✍キーワード:エクセル コメント コード セル データ
○ 状態 :終了
└ 回答数 : 3/3件

▽最新の回答へ

1 ● SALINGER
●0ポイント

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
◎質問者からの返答

> 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へこの質問の派生質問を投稿しました。

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


2 ● SALINGER
●0ポイント

失礼しました。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
◎質問者からの返答

> SALINGERさん

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

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

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

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

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

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

○実際の運用

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

__ G080701 A080607 F080710

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

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


3 ● SALINGER
●500ポイント ベストアンサー
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
◎質問者からの返答

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

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

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

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

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ