1215223897 エクセルのマクロの質問です。現在、商品番号、商品名、各店舗の入庫数など商品情報を「商品管理.xls」の"商品管理"シートに入力しています。

クリップボードにある商品番号をこのシートと照らし合わせ、クリップボードにどの商品がいくつあるのかカウントして"商品管理"シートに記録するマクロを作りたいと考えています。
概要は画像を参照ください。
マクロの知識が浅いため、解決方法そのものを教えていただければうれしいです。もしそのまま使える完全なコードややり方を回答していただいた回答者の方には500ポイントを差し上げます。よろしくお願いいたします。
※文字制限のためサンプルデータ、仕様の詳細はこの下にある「この質問・回答へのコメント」に記載いたします。

回答の条件
  • 1人5回まで
  • 登録:2008/07/05 11:11:38
  • 終了:2008/07/11 17:06:27

ベストアンサー

id:SALINGER No.2

SALINGER回答回数3454ベストアンサー獲得回数9692008/07/07 08:37:30

ポイント1500pt
Option Explicit

Sub MailAdd()
    Dim wsKan As Worksheet
    Dim SNumRetu As Integer      '商品番号列
    Dim cb As New DataObject
    Dim LastRow As Long
    Dim h
    Dim i As Long
    Dim j As Long
    Dim errorRow As Long
    Dim r As Range
    
    If ThisWorkbook.Name <> "商品管理.xls" Or ActiveSheet.Name <> "商品管理" Then
        MsgBox "操作が誤っています。メールから商品をカウントする場合は商品管理ファイルの" & _
            "商品管理シートの商品番号列でマクロを実行してください。"
        Exit Sub
    End If
    
    Set wsKan = Worksheets("商品管理")
    
    'タイトル列がない場合の処理
    Set r = wsKan.Rows(1).Find(what:="商品番号", lookat:=xlWhole)
    If r Is Nothing Then
        MsgBox "商品番号の列名は存在しません。商品管理シートを確認してください。"
        Exit Sub
    Else
        SNumRetu = r.Column
    End If
    
    If TypeName(Selection) <> "Range" Then Exit Sub
    
    If Selection.Columns.Count <> 1 Or Selection.Row <> 1 Or Selection.Column = SNumRetu Then
        MsgBox ("店舗名を選択してください。")
        Exit Sub
    End If
    
    Application.ScreenUpdating = False
    
    cb.GetFromClipboard
    If cb.GetFormat(1) Then
        h = Split(cb.GetText, vbCrLf)
        LastRow = wsKan.Cells(Cells.Rows.Count, SNumRetu).End(xlUp).Row
        errorRow = LastRow + 3
        If MsgBox("新規のデータとしてカウントしますか?" & vbNewLine & _
            "[はい] →新規のデータとしてカウントする" & vbNewLine & _
            "[いいえ] →データを追加する", vbYesNo) = vbYes Then
            wsKan.Range(wsKan.Cells(2, Selection.Column), wsKan.Cells(65536, Selection.Column)).Clear
        Else
            wsKan.Range(wsKan.Cells(LastRow + 1, Selection.Column), wsKan.Cells(65536, Selection.Column)).Clear
        End If
        For j = 0 To UBound(h)
            For i = 2 To LastRow
                If wsKan.Cells(i, SNumRetu).Value = h(j) Then
                    wsKan.Cells(i, Selection.Column).Value = wsKan.Cells(i, Selection.Column).Value + 1
                    Exit For
                End If
                If i = LastRow Then
                    wsKan.Cells(LastRow + 2, Selection.Column).Value = "エラー"
                    wsKan.Cells(errorRow, Selection.Column).Value = h(j) & " " & j + 1 & "行目"
                    errorRow = errorRow + 1
                End If
            Next
        Next j
    End If
    
    Application.ScreenUpdating = True
End Sub

その他の回答(2件)

id:SALINGER No.1

SALINGER回答回数3454ベストアンサー獲得回数9692008/07/05 14:17:46

メールの本文をコピーして、商品番号以外の一列目を選択して実行することでその下にカウントを入れるマクロです。

新宿など店舗名はわからないので、操作するほうで正しい店舗を選択する必要があります。

もう一つ注意することは、クリップボードに文字列が入っているかどうかで処理をするのですが、

セルをコピーした後マクロを実行してしまった場合でも文字列と認識されるので意図しない動作をする場合があります。

Option Explicit

Sub MailAdd()
    Dim wsKan As Worksheet
    Dim SNumRetu As Integer      '商品番号列
    Dim cb As New DataObject
    Dim LastRow As Long
    Dim h
    Dim i As Long
    Dim j As Long
    Dim errorRow As Long
    Dim r As Range
    
    If ThisWorkbook.Name <> "商品管理.xls" Or ActiveSheet.Name <> "商品管理" Then
        MsgBox "操作が誤っています。メールから商品をカウントする場合は商品管理ファイルの" & _
            "商品管理シートの商品番号列でマクロを実行してください。"
        Exit Sub
    End If
    
    Set wsKan = Worksheets("商品管理")
    
    'タイトル列がない場合の処理
    Set r = wsKan.Rows(1).Find(what:="商品番号", lookat:=xlWhole)
    If r Is Nothing Then
        MsgBox "商品番号の列名は存在しません。商品管理シートを確認してください。"
        Exit Sub
    Else
        SNumRetu = r.Column
    End If
    
    If TypeName(Selection) <> "Range" Then Exit Sub
    
    If Selection.Columns.Count <> 1 Or Selection.Row <> 1 Or Selection.Column = SNumRetu Then
        MsgBox ("店舗名を選択してください。")
        Exit Sub
    End If
    
    Application.ScreenUpdating = False
    
    cb.GetFromClipboard
    If cb.GetFormat(1) Then
        h = Split(cb.GetText, vbCrLf)
        LastRow = wsKan.Cells(Cells.Rows.Count, SNumRetu).End(xlUp).Row
        errorRow = LastRow + 3
        wsKan.Range(Cells(LastRow + 1, Selection.Column), Cells(65536, Selection.Column)).Clear
        For j = 0 To UBound(h)
            For i = 2 To LastRow
                If wsKan.Cells(i, SNumRetu).Value = h(j) Then
                    wsKan.Cells(i, Selection.Column).Value = wsKan.Cells(i, Selection.Column).Value + 1
                    Exit For
                End If
                If i = LastRow Then
                    wsKan.Cells(LastRow + 2, Selection.Column).Value = "エラー"
                    wsKan.Cells(errorRow, Selection.Column).Value = h(j) & " " & j + 1 & "行目"
                    errorRow = errorRow + 1
                End If
            Next
        Next j
    End If
    
    Application.ScreenUpdating = True
End Sub
id:SALINGER No.2

SALINGER回答回数3454ベストアンサー獲得回数9692008/07/07 08:37:30ここでベストアンサー

ポイント1500pt
Option Explicit

Sub MailAdd()
    Dim wsKan As Worksheet
    Dim SNumRetu As Integer      '商品番号列
    Dim cb As New DataObject
    Dim LastRow As Long
    Dim h
    Dim i As Long
    Dim j As Long
    Dim errorRow As Long
    Dim r As Range
    
    If ThisWorkbook.Name <> "商品管理.xls" Or ActiveSheet.Name <> "商品管理" Then
        MsgBox "操作が誤っています。メールから商品をカウントする場合は商品管理ファイルの" & _
            "商品管理シートの商品番号列でマクロを実行してください。"
        Exit Sub
    End If
    
    Set wsKan = Worksheets("商品管理")
    
    'タイトル列がない場合の処理
    Set r = wsKan.Rows(1).Find(what:="商品番号", lookat:=xlWhole)
    If r Is Nothing Then
        MsgBox "商品番号の列名は存在しません。商品管理シートを確認してください。"
        Exit Sub
    Else
        SNumRetu = r.Column
    End If
    
    If TypeName(Selection) <> "Range" Then Exit Sub
    
    If Selection.Columns.Count <> 1 Or Selection.Row <> 1 Or Selection.Column = SNumRetu Then
        MsgBox ("店舗名を選択してください。")
        Exit Sub
    End If
    
    Application.ScreenUpdating = False
    
    cb.GetFromClipboard
    If cb.GetFormat(1) Then
        h = Split(cb.GetText, vbCrLf)
        LastRow = wsKan.Cells(Cells.Rows.Count, SNumRetu).End(xlUp).Row
        errorRow = LastRow + 3
        If MsgBox("新規のデータとしてカウントしますか?" & vbNewLine & _
            "[はい] →新規のデータとしてカウントする" & vbNewLine & _
            "[いいえ] →データを追加する", vbYesNo) = vbYes Then
            wsKan.Range(wsKan.Cells(2, Selection.Column), wsKan.Cells(65536, Selection.Column)).Clear
        Else
            wsKan.Range(wsKan.Cells(LastRow + 1, Selection.Column), wsKan.Cells(65536, Selection.Column)).Clear
        End If
        For j = 0 To UBound(h)
            For i = 2 To LastRow
                If wsKan.Cells(i, SNumRetu).Value = h(j) Then
                    wsKan.Cells(i, Selection.Column).Value = wsKan.Cells(i, Selection.Column).Value + 1
                    Exit For
                End If
                If i = LastRow Then
                    wsKan.Cells(LastRow + 2, Selection.Column).Value = "エラー"
                    wsKan.Cells(errorRow, Selection.Column).Value = h(j) & " " & j + 1 & "行目"
                    errorRow = errorRow + 1
                End If
            Next
        Next j
    End If
    
    Application.ScreenUpdating = True
End Sub
id:Mook No.3

Mook回答回数1312ベストアンサー獲得回数3912008/07/05 15:16:19

ポイント50pt

勝手ながら、仕様を何点か変更してみました。

SALINGER さんが忠実な回答をされていると思いますので、そちらがご希望に沿うようでしたらそちらを採用ください。

ポイントは不要です(いつも過分にいただいていることもありますので)。


コメントしましたが、OutLook をお使いの場合、「発注フォルダ」を作成しそこに該当メールを置いて実行してみてください。

そのフォルダ内のメールを順番に処理します。

機能を追加することも可能ですが、処理後「登録済みフォルダ」などへ移動する運用がよいと思います。


また、「商品管理」シートを選んでいない場合、エラーメッセージを出すとの仕様でしたが、

「商品管理」シートをアクティブにして処理をするようにしていますので、その点も変更しています。

Const dstFolder = "発注フォルダ"
Const errorTitle = "エラー"
Const MainSheet = "商品管理"

Sub registOrder()
    Dim olAPP As Object
    Set olAPP = CreateObject("Outlook.Application")
    
    Dim olNameSPC As Object
    Set olNameSPC = olAPP.GetNamespace("MAPI")

    Workbooks("商品管理.xls").Worksheets(MainSheet).Activate

'--- 発注フォルダを探してその中のメールを順番に処理
    Dim objItem As Object
    Dim intCounter As Integer
    Dim objFolder As Object
    For Each objFolder In olNameSPC.Folders(1).Folders
        If objFolder.Name = dstFolder Then
            For Each objItem In objFolder.items
                 intCounter = intCounter + 1
                 loadOrder objItem.Subject, objItem.body
            Next objItem
            Exit For
        End If
    Next
End Sub

'------------------------------------------------
' タイトル(支店名)と商品リストを登録
'------------------------------------------------
Sub loadOrder(title, body)
    With Worksheets(MainSheet)
        Dim items
        items = Split(body, vbNewLine)
        
        Dim ret As Range
        Set ret = .Rows(1).Find(what:=title, lookat:=xlWhole)
        If ret Is Nothing Then
            MsgBox "該当する支店名「" & title & "」がありません。"
            Exit Sub
        End If
        
        Dim bCol As Long
        bCol = ret.Column
        
        Dim i As Long
        Dim errorNum As Long
        For i = LBound(items) To UBound(items)
            If Len(items(i)) > 0 Then
                Set ret = .Columns(1).Find(what:=Trim(items(i)), lookat:=xlWhole)
                If ret Is Nothing Then
                    errorNum = addError(bCol, items(i), i - LBound(items) + 1)
                Else
                    .Cells(ret.Row, bCol).Value = .Cells(ret.Row, bCol).Value + 1
                End If
            End If
        Next
        If errorNum > 0 Then
            MsgBox "存在しない商品番号が" & errorNum & "件ありました。" & vbNewLine & "シートの最終行を確認してください。"
        End If
    End With
End Sub

'------------------------------------------------
' 該当商品がない場合、エラーを記録
'------------------------------------------------
Function addError(bCol As Long, item, iRow)
    With Worksheets(MainSheet)
        Dim ret As Range
        Dim eReg As Range
        Set ret = .Columns(bCol).Find(what:=errorTitle, lookat:=xlWhole)
        If ret Is Nothing Then
            Set ret = .Cells(Rows.Count, bCol).End(xlUp).Offset(2, 0)
            ret.Value = errorTitle
            Set eReg = ret.Offset(1, 0)
        Else
            Set eReg = ret.End(xlDown).Offset(1, 0)
        End If
        eReg.Value = item & " " & iRow & "行目"
        addError = eReg.Row - ret.Row
    End With
End Function

一点、今回の処理はセルの数値を直接加算していくものですが、処理が失敗した場合、処理漏れがあった場合、複数回処理した場合、

数値を修正・復元することは管理上困難です。

読み込んだデータをすべて個別に登録管理し、そこから集計するか、少なくともその記録と合わせて管理する方が好ましい

かと思います。

  • id:icta
    このマクロを利用するのはエクセルの知識がほとんどない販売スタッフです。
    エクセルを知らなくても簡単に商品をカウントできるマクロを作成したいと考えています。
    お知恵とお力をお借りできれば幸いです。
    仕様で何かご不明な点ありましたらお知らせください。


    ■マクロの仕様

    ○概要
    ・各店舗からメールで商品番号が改行で入力されたデータが送られる。
    ・メールの内容をすべてコピー。クリップボードに保存される。
    ・「商品管理.xls」の"商品管理"シートのタイトル行から該当する店舗を選択。
    ・マクロ実行。
    ・「商品管理.xls」の"商品管理"シートのタイトル行から"商品番号"列を探す。
    ・クリップボードの内容を順に"商品番号"列から探し、該当するものがあれば選択している"店舗"列に1を足していく。
    ・クリップボードの内容をすべてカウントし終えたらマクロを終了する。

    ○詳細
    ・商品番号はバーコードリーダーで新規メールに読み取る。
    ・「商品管理.xls」の"商品管理"シートのタイトル行でマクロが実行されない場合は▼次のメッセージを表示する。
     「商品をカウントするには商品管理.xlsの商品管理シートのタイトル行で店舗を選択しマクロを実行してください。」
    ・"商品管理"シートに存在しない行があったら、最終行より1行下にエラーの番号と行数を表示する。
    ・マクロ終了時に存在しない商品番号があった場合は▼次のメッセージを表示する。
     「存在しない商品番号が○件ありました。シートの最終行を確認してください。」


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

    ○メール
    S060302PK0
    H020101SV3
    S060302PK0
    R050901NV1
    H040101BK3
    H040101BK3
    H040101BK2

    ○商品管理
    商品番号 商品名 上野 新宿 原宿
    S060302PK0 カーディガン/ピンク/ワンサイズ
    H020101SV3 リング/シルバー/9号
    R050901NV1 ジーンズ/ネイビー/1
    J040101SV2 ジャケット/シルバー/2
    H040101BK3 シューズ/ブラック/3
  • id:Mook
    メールの内容をコピーしたときに、クリップボードで提示されたような状態が再現できないのですが、
    お使いのメールソフトは何ですか?

    OutLook であれば、特定のフォルダにメールを置いてそれを読み取るということも可能です。
  • id:icta
    >SALINGERさん
    早々のご回答ありがとうございました。早速試してみたのですが、
    Dim cb As New DataObject の部分で
    コンパイルエラー
    ユーザ定義型は定義されていません。
    というエラーが表示されてしまいます。
    エラーを検索してみて▼以下の方法も試したのですが、同じ結果でした。
    http://www.tsware.jp/tips/tips_334.htm
    設定の問題だと思われますのでどこをどのように変更すればよろしいでしょうか?
    お時間の許すときに教えていただければ幸いです。

    >Mookさん
    > お使いのメールソフトは何ですか?
    OutlookExpressです。
    このマクロは棚卸し用のマクロなので年に1回、全店舗からのデータを集めたときにしか利用しません。
    特定のフォルダから読み取るのは何か別の機会に利用できそうです。

  • id:SALINGER
    すいません。
    Microsoft Forms 2.0 Object Libraryの参照設定が必要なことを書き忘れました。
    VBEの画面から、ツール→参照設定で
    Microsoft Forms 2.0 Object Libraryにチェックを入れてOKを押してください。
  • id:SALINGER
    リンク先はVBEからアクセスのデータベースファイルを操作するための参照設定ですね。
  • id:Mook
    提示のコードは、Outlook 用で OutlookExpress では動作しませんので、読み捨てください。

    何らかの方法で、メールのタイトルと本文を title と body の引数として渡すように修正すれば、
    利用は可能ですが、SALINGER さんので事足りるのであれば、そちらをご利用ください。
  • id:icta
    >SALINGER さん

    返信が遅くなりまして申し訳ありません。
    教えていただいた方法で希望通りの動作を確認しました。

    実際に使ってみて気がついたのですが、スタッフが操作を誤らないよう▼次の仕様を入れることは可能でしょうか?
    ↓マクロ実行
    ↓次のメッセージを出す。
     「新規のデータとしてカウントしますか?
      [はい]→新規のデータとしてカウント
      [いいえ]→データを追加する

     [はい]をクリックした場合、現在選択中の店舗名の下から最終行を空にしてからカウントを始める。
     [いいえ]をクリックした場合、すでにデータが入っているセルは既存の値に+1していく。

    いつも後からの仕様変更で申し訳ありません。
    お手数おかけしますよろしくお願いいたします。

    >Mookさん

    ご回答ありがとうございます。
    せっかく作っていただいたのに心苦しいのですが、スタッフが誰一人としてOutlookを使えないためせっかくのプログラムを活用できません。
    大変残念でなりません。
  • id:Mook
    今回、一部勝手に仕様を変えており、要望されている仕様にマッチしていないので、
    「採用しません。」ということで全く依存はありませんが、ポイントは不要ですので
    気が向いたらオープンください。

    メールが OutlookExpress でしたらそれに対処する対応も可能ですが、今回はメールから
    は行わないという方針のようですので、今回の仕様の変更は余計でした。

    全体に関してお聞きしたいのですが、これまでのマクロはそれぞれ処理のもととなるシートなり
    ブックに配してるのでしょうか。また、起動はショートカット等を利用されているのでしょうか。
    マクロの起動を対象のシート上のボタンにすれば、「対象シートが選ばれていない」等のチェックや
    エラーメッセージは不要になるかと思うのですが。

    まぁいずれにせよ、今回はSALINGERさんのを採用されたようなので、これ以上のコメントは
    余計だと思いますので控ます。
  • id:icta
    >Mookさん

    > メールが OutlookExpress でしたらそれに対処する対応も可能ですが、今回はメールから
    > は行わないという方針のようですので、今回の仕様の変更は余計でした。

    このマクロは恒久的なものなく、棚卸しのときだけに用います。
    棚卸しの性質上、作業中に在庫を別店舗に付け替えたり、後から在庫の追加/廃棄が頻繁に行われます。
    そのため店舗名を選択して基本的な動作だけで行えるようにした次第です。
    基本的動作に限定することで以下のようなことでも同じマクロで柔軟に対応できます。
    1番目の棚卸しのマクロ実行後に、列を新たに挿入。
    2番目の棚卸しのマクロ実行をこの新しい列の上で行う。
    1番目と2番目を比較すればどの商品が追加されたか一目瞭然。

    > 全体に関してお聞きしたいのですが、これまでのマクロはそれぞれ処理のもととなるシートなり
    > ブックに配してるのでしょうか。また、起動はショートカット等を利用されているのでしょうか。
    > マクロの起動を対象のシート上のボタンにすれば、「対象シートが選ばれていない」等のチェックや
    > エラーメッセージは不要になるかと思うのですが。

    私がボタンよりショートカットが好きなので、ほとんどショートカットを付けています。
    ボタンはわかりやすいのですが、マウスを移動→セル選択→マウスを移動→ボタン選択→クリックのようにステップ数が長くなってしまいます。
    ショートカットなら、左手でショートカット、右手でマウスを使えるのですばやく動作できます。
    ショートカットは覚えやすいように、ラベル作成なら(Label)のL、画像を挿入するなら(Gazou)のGというように決めています。
    またボタンを作成するのが面倒という無精な原因もあります。

    ショートカットの欠点は入力ミスが多いことです。
    誤って隣のキーをクリックしてしまったりすることがあります。
    かなりよくあるため、エラーメッセージを出すようにしておく必要があります。
    Mookさんは恐らくこの辺りを配慮していただいてボタンを薦められているのだと思います。

    今回のシステム製作でよくわかったのですが、システム製作よりもスタッフの教育がいちばん大変で時間がかかるということです。
    前回、業者に製作してもらったシステムが失敗したのもよくわかります。
    業者は教育までは行わないし、スタッフからの「ここが使いにくい」というフィードバックを挙げることもなかったからです。

    バーコード導入後にこれまでこのはてなで作っていただいたシステムがうまく稼動するかどうか楽しみであり不安でもあります。
  • id:Mook
    ユーザインタフェースの難しさは、ある人にとっての快適な操作性が必ずしも万人のものでは
    ないということだと思います。

    ショートカットの利点はおっしゃる通り操作の利便性ですが、それを便利だと思わない人も多い
    ですし、システムに不慣れな人は使い始めるのに時間がかかります。
    なので、私自身はショートカットを多用していますが、人に提供するものはほとんどGUIベースに
    しています。

    今回の一連のものは、パソコンに不慣れなスタッフの方が使うということでしたので、ボタンの
    ほうが良いのではと提言した次第です。


    教育の大変さはまったくもってその通りですね。使いやすいシステムを作るのはもちろんですが、
    システム以上にユーザ教育やわかりやすいユーザマニュアルの作成に労力がかかります。

    まぁ、仕様を作成するのが実際の業務に精通している icta さん自身というのが今回の最大
    の強みでしょうか。
    操作性に限らず、処理などに関してもスタッフの方からフィードバックを収集し、今後に生かされてはと
    思います。

    これまでの経験上、どんなに考えつくしたように思っていても、ユーザからは思いもかけない意見が寄せ
    られるのが常なので。
  • id:icta
    >SALINGER さん

    返信が遅くなりまして申し訳ありません。
    完全に希望通りの動作を確認しました。
    早々の対応ありがとうございました。
    いよいよ明日明後日で、全店舗にバーコードを付ける作業とこのマクロを用いた棚卸しを行います。
    恐らく問題ないと思いますが、いままでのように運用してみて変更点などに気がつくことがありますので、いったん質問を締切、運用後、問題が生じなければ質問を終了いたします。
    それまでもうしばらくお待ちいただけますでしょうか?
    運用後に変更点に気がつきましたら、またコメントを付けます。
    ご都合のよいときにお力をお借りできれば幸いです。
    質問終了は今週の金曜日を予定しております。
  • id:SALINGER
    >icta
    今までたくさんのマクロを依頼されたので、管理に大変だと思います。
    私自身最初の頃に作ったマクロはもう覚えてないような始末です。
    今までのマクロ群が何をするためのマクロかをコメントやノートなどに書き留めておかないと
    管理が難しいかもしれませんね。合わせて整理運用上の注意点とかもあるし大変だと思います。
    マクロを使うことで今までその仕事にかかっていた時間が少しでも短縮されれば作ったかいがあったというものです。

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

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

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

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