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

エクセルのマクロの質問です。実店舗と通販の在庫管理、顧客管理をエクセルで行っています。
実店舗は「来店記録」と「顧客名簿」、通販は「通販管理」というファイルに記録しています。現在各々のファイルが関連付けられていないので在庫管理、顧客管理に役立っていません。
そこで実店舗の「来店記録」に通販の購入履歴を載せることで顧客の購入履歴を一元化しようと考えました。
「通販管理」から購入履歴を「来店記録」にマクロで転記したいと思います。
「通販管理」の複数行を選択したとき、その中から必要なデータだけを取り出し、「来店記録」に転記するにはどうしたらよいでしょうか?
マクロの知識が浅いため、解決方法そのものを教えていただければうれしいです。もしそのまま使える完全なコードややり方を回答していただいた回答者の方には500ポイントを差し上げます。よろしくお願いいたします。
※文字制限のため「来店記録」、「通販管理」のサンプルデータ、仕様の詳細はこの下にある「この質問・回答へのコメント」に記載いたします。

●質問者: icta
●カテゴリ:コンピュータ
✍キーワード:エクセル コメント コード データ ファイル
○ 状態 :終了
└ 回答数 : 2/2件

▽最新の回答へ

1 ● SALINGER
●0ポイント

作ってみました。

一度配列に格納することはしませんでした。配列を使ってもいいのですが、Excelのシート自体が配列のようなものなので

重複するかなと思ったからです。

それから、コメントを見ると担当のところに数字が入っているようですが、わからなかったので省きました。

転記自体は短いコードでいいのですが、見出しの検索や想定されるエラーを組み込むと長いコードになってしまいました。

Sub MacroTenki()
 Dim i As Integer
 Dim j As Integer
 Dim raiten_Last As Long  '来店記録の最終行
 Dim tuuhan_Last As Long  '通販管理の最終行
 Dim Rmidasi_name(13) As String  '来店記録の見出の文字列
 Dim Tmidasi_name(13) As String  '通販管理の見出の文字列
 Dim Rmidasi_column(13) As Integer  '来店記録の見出の位置
 Dim Tmidasi_column(13) As Integer  '通販管理の見出の位置
 Dim r As Range
 Dim err_Mes As String  'エラーメッセージ
 Dim strDate As String
 Dim myDate As Date
 
  '来店記録の見出の文字列。シートを変更する場合はこちらも変更
 Rmidasi_name(0) = "店舗"
 Rmidasi_name(1) = "会員番号"
 Rmidasi_name(2) = "旧会員番号"
 Rmidasi_name(3) = "会員資格"
 Rmidasi_name(4) = "名前"
 Rmidasi_name(5) = "フリガナ"
 Rmidasi_name(6) = "来店日"
 Rmidasi_name(7) = "売上"
 Rmidasi_name(8) = "ポイント"
 Rmidasi_name(9) = "バッグポイント"
 Rmidasi_name(10) = "累計P数"
 Rmidasi_name(11) = "コメント"
 Rmidasi_name(12) = "商品名"
 Rmidasi_name(13) = "商品番号"
 
  '通販管理の見出の文字列。シートを変更する場合はこちらも変更
 Tmidasi_name(0) = ""
 Tmidasi_name(1) = "会員番号"
 Tmidasi_name(2) = "旧会員番号"
 Tmidasi_name(3) = "会員資格"
 Tmidasi_name(4) = "名前"
 Tmidasi_name(5) = "フリガナ"
 Tmidasi_name(6) = "注文番号"
 Tmidasi_name(7) = "売上"
 Tmidasi_name(8) = "ポイント"
 Tmidasi_name(9) = "バッグポイント"
 Tmidasi_name(10) = "累計ポイント"
 Tmidasi_name(11) = "コメント"
 Tmidasi_name(12) = "商品名"
 Tmidasi_name(13) = "商品番号"
 
 Const raiten_Midasi As Long = 1  '来店記録の見出の行
 Const tuuhan_Midasi As Long = 1  '通販管理の見出の行
 
 For j = 0 To 13
 For i = 1 To 256
 If Worksheets("来店記録").Cells(raiten_Midasi, i).Value = Rmidasi_name(j) Then
 Rmidasi_column(j) = i
 Exit For
 End If
 Next i
 Next j
 For i = 0 To 13
 If Rmidasi_column(i) = 0 Then
 MsgBox "来店記録の見出を確認してください"
 Exit Sub
 End If
 Next i
 For j = 1 To 13
 For i = 1 To 256
 If Worksheets("通販管理").Cells(tuuhan_Midasi, i).Value = Tmidasi_name(j) Then
 Tmidasi_column(j) = i
 Exit For
 End If
 Next i
 Next j
 For i = 1 To 13
 If Tmidasi_column(i) = 0 Then
 MsgBox "通販管理の見出を確認してください"
 Exit Sub
 End If
 Next i
 
 raiten_Last = Worksheets("来店記録").Cells(Rows.Count, Rmidasi_column(0)).End(xlUp).Row
 tuuhan_Last = Worksheets("通販管理").Cells(Rows.Count, Selection.Column).End(xlUp).Row
 
  '在庫管理の日付のチェック
 With Worksheets("来店記録")
 For i = raiten_Midasi + 1 To raiten_Last
 If IsDate(.Cells(i, Rmidasi_column(6))) Then
 If myDate > DateValue(.Cells(i, Rmidasi_column(6))) Then
 MsgBox "来店記録の来店日が日付順になっていません"
 Exit Sub
 Else
 myDate = DateValue(.Cells(i, Rmidasi_column(6)))
 End If
 Else
 MsgBox "在庫管理の来店日に日付以外が入力されています"
 Exit Sub
 End If
 Next i
 End With
 
  '転記部分
 With Worksheets("通販管理")
 For Each r In Selection
 If r.Column = Tmidasi_column(4) And r.Row > tuuhan_Midasi And r.Row <= tuuhan_Last Then
 strDate = .Cells(r.Row, Tmidasi_column(6)).Value
 strDate = "20" & Left(strDate, 2) & "/" & Mid(strDate, 3, 2) & "/" & Mid(strDate, 5, 2)
 If IsDate(strDate) Then
 For i = raiten_Midasi + 1 To raiten_Last + 1
 If DateValue(strDate) < Worksheets("来店記録").Cells(i, Rmidasi_column(6)).Value Or _
 Worksheets("来店記録").Cells(i, Rmidasi_column(6)).Value = "" Then
 Worksheets("来店記録").Rows(i).EntireRow.Insert
 Worksheets("来店記録").Cells(i, Rmidasi_column(0)).Value = "通販"
 For j = 1 To 13
 Worksheets("来店記録").Cells(i, Rmidasi_column(j)).Value = .Cells(r.Row, Tmidasi_column(j)).Value
 Next j
 Worksheets("来店記録").Cells(i, Rmidasi_column(6)).Value = DateValue(strDate)
 raiten_Last = raiten_Last + 1
 Exit For
 End If
 Next i
 Else
 err_Mes = err_Mes & r.Row & "行の日付が不正です" & vbCrLf
 End If
 End If
 Next r
 End With
 
 If err_Mes <> "" Then MsgBox err_Mes
End Sub
◎質問者からの返答

> SALINGERさん

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

完全に希望通りの動作を確認しました。

"累計ポイント"と"累計P"の表記の未統一や日付順に並んでいない場合はエラーメッセージを出すところまで気を配っていただきありがとうございました。

表記の未統一は本来統一すべきものなので修正しました。ファイルはそれぞれの担当者が勝手に列を増やして行ったため未統一のものが多く、これには気がつきませんでした。

日付順のエラーメッセージも日付どおりになっていない箇所があることに改めて気がつかされました。

細かいところまでに行き届いた設計で大変うれしいです。

エクセルをまったく知らないスタッフの気持ちになって操作してみると、次のような機能があると安心できるかもしれないと思いました。

○「通販管理」シートの"名前"列を選択しないでマクロを実行すると「操作が誤っています。通販管理で名前を選択してから実行してください」というエラーメッセージを出す。

○マクロを正常に終了したときは「××件の転記を終了しました」というメッセージを表示する。

○「通販管理」に"来店記録チェック"という列を新たに設けておき、「来店記録」に転記したときはここに"済"と入れる。もし誤って"済"の付いた行を転記しようとしたときは「転記済みのデータが含まれています。選択を見直してください」というエラーメッセージを出す。

多数のスタッフが操作しますので操作のあやまり防止用のために必要になると思われます。

後からの機能追加でいつも大変心苦しいのですがお力をお借りできれば幸いです。

> コメントを見ると担当のところに数字が入っているようですが、わからなかったので省きました。

申し訳ありません。記載のときの誤りです。お手数をおかけしました。


2 ● SALINGER
●1500ポイント ベストアンサー

3つの機能追加しました。

3つ目ですが、転記済みのデータはとばして、それ以外を転記し、転記済みのデータが含まれていたことを表示するようにしました。


注)プラウザの横幅が狭いと勝手にコードが右端で折り返されることがあるので、コピーするときは折り返されてるところは直してください。

Sub MacroTenki()
 Dim i As Integer
 Dim j As Integer
 Dim raiten_Last As Long  '来店記録の最終行
 Dim tuuhan_Last As Long  '通販管理の最終行
 Dim Rmidasi_name(13) As String  '来店記録の見出の文字列
 Dim Tmidasi_name(14) As String  '通販管理の見出の文字列
 Dim Rmidasi_column(13) As Integer  '来店記録の見出の位置
 Dim Tmidasi_column(14) As Integer  '通販管理の見出の位置
 Dim r As Range
 Dim err_Mes As String  'エラーメッセージ
 Dim strDate As String
 Dim myDate As Date
 Dim fSelect As Boolean  '名前が選択されているか
 Dim myCount As Long  '転記数
 Dim fZumi As Boolean  '済の行を転記しようとしたか
 
  '来店記録の見出の文字列。シートを変更する場合はこちらも変更
 Rmidasi_name(0) = "店舗"
 Rmidasi_name(1) = "会員番号"
 Rmidasi_name(2) = "旧会員番号"
 Rmidasi_name(3) = "会員資格"
 Rmidasi_name(4) = "名前"
 Rmidasi_name(5) = "フリガナ"
 Rmidasi_name(6) = "来店日"
 Rmidasi_name(7) = "売上"
 Rmidasi_name(8) = "ポイント"
 Rmidasi_name(9) = "バッグポイント"
 Rmidasi_name(10) = "累計P数"
 Rmidasi_name(11) = "コメント"
 Rmidasi_name(12) = "商品名"
 Rmidasi_name(13) = "商品番号"
 
  '通販管理の見出の文字列。シートを変更する場合はこちらも変更
 Tmidasi_name(0) = ""
 Tmidasi_name(1) = "会員番号"
 Tmidasi_name(2) = "旧会員番号"
 Tmidasi_name(3) = "会員資格"
 Tmidasi_name(4) = "名前"
 Tmidasi_name(5) = "フリガナ"
 Tmidasi_name(6) = "注文番号"
 Tmidasi_name(7) = "売上"
 Tmidasi_name(8) = "ポイント"
 Tmidasi_name(9) = "バッグポイント"
 Tmidasi_name(10) = "累計ポイント"
 Tmidasi_name(11) = "コメント"
 Tmidasi_name(12) = "商品名"
 Tmidasi_name(13) = "商品番号"
 Tmidasi_name(14) = "来店記録チェック"
 
 Const raiten_Midasi As Long = 1  '来店記録の見出の行
 Const tuuhan_Midasi As Long = 1  '通販管理の見出の行
 
 For j = 0 To 13
 For i = 1 To 256
 If Worksheets("来店記録").Cells(raiten_Midasi, i).Value = Rmidasi_name(j) Then
 Rmidasi_column(j) = i
 Exit For
 End If
 Next i
 Next j
 For i = 0 To 13
 If Rmidasi_column(i) = 0 Then
 MsgBox "来店記録の見出を確認してください"
 Exit Sub
 End If
 Next i
 For j = 1 To 14
 For i = 1 To 256
 If Worksheets("通販管理").Cells(tuuhan_Midasi, i).Value = Tmidasi_name(j) Then
 Tmidasi_column(j) = i
 Exit For
 End If
 Next i
 Next j
 For i = 1 To 14
 If Tmidasi_column(i) = 0 Then
 MsgBox "通販管理の見出を確認してください"
 Exit Sub
 End If
 Next i
 
 raiten_Last = Worksheets("来店記録").Cells(Rows.Count, Rmidasi_column(0)).End(xlUp).Row
 tuuhan_Last = Worksheets("通販管理").Cells(Rows.Count, Selection.Column).End(xlUp).Row
 
  '在庫管理の日付のチェック
 With Worksheets("来店記録")
 For i = raiten_Midasi + 1 To raiten_Last
 If IsDate(.Cells(i, Rmidasi_column(6))) Then
 If myDate > DateValue(.Cells(i, Rmidasi_column(6))) Then
 MsgBox "来店記録の来店日が日付順になっていません"
 Exit Sub
 Else
 myDate = DateValue(.Cells(i, Rmidasi_column(6)))
 End If
 Else
 MsgBox "在庫管理の来店日に日付以外が入力されています"
 Exit Sub
 End If
 Next i
 End With
 
  '転記部分
 With Worksheets("通販管理")
 For Each r In Selection
 If r.Column = Tmidasi_column(4) And r.Row > tuuhan_Midasi And r.Row <= tuuhan_Last Then
 fSelect = True
 If .Cells(r.Row, Tmidasi_column(14)).Value <> "済" Then
 strDate = .Cells(r.Row, Tmidasi_column(6)).Value
 strDate = "20" & Left(strDate, 2) & "/" & Mid(strDate, 3, 2) & "/" & Mid(strDate, 5, 2)
 If IsDate(strDate) Then
 For i = raiten_Midasi + 1 To raiten_Last + 1
 If DateValue(strDate) < Worksheets("来店記録").Cells(i, Rmidasi_column(6)).Value Or _
 Worksheets("来店記録").Cells(i, Rmidasi_column(6)).Value = "" Then
 Worksheets("来店記録").Rows(i).EntireRow.Insert
 Worksheets("来店記録").Cells(i, Rmidasi_column(0)).Value = "通販"
 For j = 1 To 13
 Worksheets("来店記録").Cells(i, Rmidasi_column(j)).Value = .Cells(r.Row, Tmidasi_column(j)).Value
 Next j
 Worksheets("来店記録").Cells(i, Rmidasi_column(6)).Value = DateValue(strDate)
 .Cells(r.Row, Tmidasi_column(14)).Value = "済"
 myCount = myCount + 1
 raiten_Last = raiten_Last + 1
 Exit For
 End If
 Next i
 Else
 err_Mes = err_Mes & r.Row & "行の日付が不正です" & vbCrLf
 End If
 Else
 fZumi = True
 End If
 End If
 Next r
 End With
 
 If fSelect Then
 MsgBox myCount & "件の転記を終了しました"
 Else
 MsgBox "通販管理シートで名前を選択してから実行してください"
 End If
 If err_Mes <> "" Then MsgBox err_Mes
 If fZumi Then MsgBox "転記済みのデータが含まれていました"
End Sub
◎質問者からの返答

> SALINGERさん

早々の機能追加ありがとうございました。

これならばスタッフたちも使いこなせそうです。

イレギュラー対処のコードの方が本体のコードより長くなってしまうかもしれませんが、実際の運用を考えると絶対必要な部分なのでしょうね。

SALINGERさんのおかげで作業をずいぶん簡略化することができました。

ほんの気持ちですがポイントを大目に入れておきます。

新しい質問を投稿しましたのでもしお時間ありましたらご覧になってみてください。

http://q.hatena.ne.jp/1211105656

目指す改善まであともう少しです。

あと少しだけおつきあいいただければうれしいです。

関連質問


●質問をもっと探す●



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