エクセルのマクロの質問です。各店舗にまたがる在庫の管理を行いたいと考えています。

来店客の購入履歴を「来店記録」、商品番号と商品名のリストを「商品リスト」、在庫を「在庫管理」というファイルに記録しています。現在各々のファイルが関連付けられていないので在庫管理に役立っていません。
「来店記録」には全店舗での購入履歴が記録されています。マクロを実行することで「来店記録」に記録されている商品番号をカウントして「在庫管理」の数を調整するにはどのようにしたらよいでしょうか?
マクロの知識が浅いため、解決方法そのものを教えていただければうれしいです。もしそのまま使える完全なコードややり方を回答していただいた回答者の方には500ポイントを差し上げます。よろしくお願いいたします。
※文字制限のため「来店記録」、「商品リスト」、「在庫管理」のサンプルデータ、仕様の詳細はこの下にある「この質問・回答へのコメント」に記載いたします。

回答の条件
  • 1人5回まで
  • 登録:2008/05/16 10:28:01
  • 終了:2008/05/17 18:13:01

ベストアンサー

id:SALINGER No.3

SALINGER回答回数3454ベストアンサー獲得回数9692008/05/17 16:58:44

ポイント500pt

来店記録の商品番号の列に空白がでるまで処理を実行するように作っています。

それで、途中空白があっても最終行まで処理するようにちょっとだけ変更しました。

Sub SyukkoCount()
    Dim lastRow As Long         '在庫管理の最終行
    Dim lastRow2 As Long        '顧客名簿の最終行
    Dim i As Integer
    Dim j As Integer
    Dim k As Integer
    Dim r As Long
    Dim c As Integer
    Dim d As Date
    Dim hairetu() As String     '複数の商品番号を格納
    Dim f1 As Boolean
    Dim f2 As Boolean
    Dim kosuu As Integer        '×2など表示されていいた場合の個数
    Dim kakeru As Integer       '商品番号で×が出て来る位置
    Dim tenpo As Integer        '来店記録の店舗の列
    Dim raitenbi As Integer     '来店記録の来店日の列
    Dim uriage As Integer       '来店記録の売上の列
    Dim shyouhin As Integer     '来店記録の商品番号の列
    Dim startDay As Date        '開始日
    Dim endDay As Date          '終了日
    Dim ra As Range
    Dim hTenpo() As String      '店舗のエラーを記録
    Dim hSyouhin() As String    '商品番号のエラーを記録
    Dim r2 As Long
    
    ReDim hTenpo(1, 0) As String
    ReDim hSyouhin(1, 0) As String
    
    '定数、環境によって変更
    Const tenpo_gyou As Integer = 3         '在庫管理の店舗の行
    Const shouhin_retsu  As Integer = 1     '在庫管理の商品番号の列
    Const midasi_gyou As Integer = 1        '来店記録の見出しの行
    
    With Worksheets("来店記録")
        For i = 1 To 256
            If .Cells(midasi_gyou, i).Value = "店舗" Then
                tenpo = i
                Exit For
            End If
        Next i
        For i = 1 To 256
            If .Cells(midasi_gyou, i).Value = "来店日" Then
                raitenbi = i
                Exit For
            End If
        Next i
        For i = 1 To 256
            If .Cells(midasi_gyou, i).Value = "売上" Then
                uriage = i
                Exit For
            End If
        Next i
        For i = 1 To 256
            If .Cells(midasi_gyou, i).Value = "商品番号" Then
                shyouhin = i
                Exit For
            End If
        Next i
        If tenpo * raitenbi * uriage * shyouhin = 0 Then
            MsgBox "適切な来店記録の見出行を指定してください"
            Exit Sub
        End If
    End With
    
    With Worksheets("在庫管理")
        '開始日と終了日を取得
        Set ra = Worksheets("在庫管理").Cells.Find("開始日")
        If ra Is Nothing Then
            MsgBox "開始日が見つかりません"
            Exit Sub
        Else
            If IsDate(ra.Offset(0, 1).Value) Then
                startDay = ra.Offset(0, 1).Value
            Else
                MsgBox "開始日の右に正しい日付を入力してください"
                Exit Sub
            End If
        End If
        Set ra = Worksheets("在庫管理").Cells.Find("終了日")
        If ra Is Nothing Then
            MsgBox "終了日が見つかりません"
            Exit Sub
        Else
            If IsDate(ra.Offset(0, 1).Value) Then
                endDay = ra.Offset(0, 1).Value
            Else
                MsgBox "終了日の右に正しい日付を入力してください"
                Exit Sub
            End If
        End If
            
        '在庫管理が何行目まであるかを調べる
        lastRow = tenpo_gyou + 2
        While .Cells(lastRow, shouhin_retsu).Value <> ""
            lastRow = lastRow + 1
        Wend
        lastRow = lastRow - 1
        
        lastRow2 = Worksheets("来店記録").Cells(Rows.Count, shyouhin).End(xlUp).Row
        '出庫のクリア
        .Activate
        For i = 3 To 256
            If .Cells(tenpo_gyou + 1, i).Value = "出庫" And .Cells(tenpo_gyou, i - 1) <> "合計" Then
                .Range(Cells(tenpo_gyou + 2, i), Cells(lastRow, i)).Clear
            End If
        Next i
        
        For i = midasi_gyou + 1 To lastRow2
            d = Worksheets("来店記録").Cells(i, raitenbi).Value
            If startDay <= d And endDay >= d Then
                hairetu = Split(Worksheets("来店記録").Cells(i, shyouhin).Value, ",")
                For j = 0 To UBound(hairetu)
                    If hairetu(j) <> "" Then
                        kosuu = 1
                        kakeru = InStr(1, hairetu(j), "×")
                        If kakeru > 0 Then
                            kosuu = CInt(Mid(hairetu(j), kakeru + 1))
                            hairetu(j) = Mid(hairetu(j), 1, kakeru - 1)
                        End If
                        
                        f1 = False
                        f2 = False
                        For r = tenpo_gyou + 2 To lastRow
                            If .Cells(r, shouhin_retsu).Value = hairetu(j) Then
                                f1 = True
                                Exit For
                            End If
                        Next r
                        For c = 3 To 256
                            If .Cells(tenpo_gyou, c).Value = Worksheets("来店記録").Cells(i, tenpo).Value Then
                                f2 = True
                                Exit For
                            End If
                        Next c
                        
                        If f1 = True And f2 = True Then
                            If Worksheets("来店記録").Cells(i, uriage).Value >= 0 Then
                                .Cells(r, c + 1).Value = .Cells(r, c + 1).Value + kosuu
                            Else
                                .Cells(r, c + 1).Value = .Cells(r, c + 1).Value - kosuu
                            End If
                        Else
                            If f1 = False Then
                                ReDim Preserve hSyouhin(1, UBound(hSyouhin, 2) + 1)
                                hSyouhin(0, UBound(hSyouhin, 2)) = hairetu(j)
                                hSyouhin(1, UBound(hSyouhin, 2)) = i
                            End If
                            If f2 = False Then
                                ReDim Preserve hTenpo(1, UBound(hTenpo, 2) + 1)
                                hTenpo(0, UBound(hTenpo, 2)) = Worksheets("来店記録").Cells(i, tenpo).Value
                                hTenpo(1, UBound(hTenpo, 2)) = i
                            End If
                        End If
                    End If
                Next j
            End If
        Next i
        
        '前のエラーのクリア
        lastRow = lastRow + 1
        .Range(Cells(lastRow, 1), Cells(65536, 1)).Clear
        
        'エラーの表示
        If UBound(hTenpo, 2) > 0 Then
            lastRow = lastRow + 1
            .Cells(lastRow, 1).Value = "間違った店舗が入力されています。"
            lastRow = lastRow + 1
            For i = 1 To UBound(hTenpo, 2)
                .Cells(lastRow, 1).Value = hTenpo(0, i) & " " & hTenpo(1, i) & "行"
                lastRow = lastRow + 1
            Next i
        End If
        
        If UBound(hSyouhin, 2) > 0 Then
            lastRow = lastRow + 1
            .Cells(lastRow, 1).Value = "間違った商品番号が入力されています。"
            lastRow = lastRow + 1
            For i = 1 To UBound(hSyouhin, 2)
                .Cells(lastRow, 1).Value = hSyouhin(0, i) & " " & hSyouhin(1, i) & "行"
                lastRow = lastRow + 1
            Next i
        End If
        
    End With
End Sub
id:icta

> SALINGERさん

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

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

これで念願だった在庫管理ができそうです。

スタッフにも喜んでもらえそうです。

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

2008/05/17 18:12:10

その他の回答(2件)

id:SALINGER No.1

SALINGER回答回数3454ベストアンサー獲得回数9692008/05/16 19:59:49

変数が多くなって見づらいですが、こんな感じでどうでしょうか。

Sub SyukkoCount()
    Dim lastRow As Long
    Dim i As Integer
    Dim j As Integer
    Dim k As Integer
    Dim r As Long
    Dim c As Integer
    Dim d As Date
    Dim hairetu() As String
    Dim f1 As Boolean
    Dim f2 As Boolean
    Dim kosuu As Integer
    Dim kakeru As Integer
    
    With Worksheets("在庫管理")
        '在庫管理が何行目まであるかを調べる
        lastRow = 5
        While .Cells(lastRow, 1).Value <> ""
            lastRow = lastRow + 1
        Wend
        lastRow = lastRow - 1
        
        '出庫のクリア
        .Activate
        k = 3
        While .Cells(3, k).Value <> "合計"
            If .Cells(4, k + 1).Value = "出庫" Then
                .Range(Cells(5, k + 1), Cells(lastRow, k + 1)).Clear
            End If
            k = k + 1
        Wend
        
        i = 2
        While Worksheets("来店記録").Cells(i, 1).Value <> ""
            d = Worksheets("来店記録").Cells(i, 7).Value
            If .Cells(1, 2).Value <= d And .Cells(2, 2).Value >= d Then
                hairetu = Split(Worksheets("来店記録").Cells(i, 11).Value, ",")
                For j = 0 To UBound(hairetu)
                    If hairetu(j) <> "" Then
                        kosuu = 1
                        kakeru = InStr(1, hairetu(j), "×")
                        If kakeru > 0 Then
                            kosuu = CInt(Mid(hairetu(j), kakeru + 1))
                            hairetu(j) = Mid(hairetu(j), 1, kakeru - 1)
                        End If
                        
                        f1 = False
                        f2 = False
                        For r = 5 To lastRow
                            If .Cells(r, 1).Value = hairetu(j) Then
                                f1 = True
                                Exit For
                            End If
                        Next r
                        For c = 3 To k
                            If .Cells(3, c).Value = Worksheets("来店記録").Cells(i, 1).Value Then
                                f2 = True
                                Exit For
                            End If
                        Next c
                        
                        If f1 = True And f2 = True Then
                            If Worksheets("来店記録").Cells(i, 9).Value >= 0 Then
                                .Cells(r, c + 1).Value = .Cells(r, c + 1).Value + kosuu
                            Else
                                .Cells(r, c + 1).Value = .Cells(r, c + 1).Value - kosuu
                            End If
                        Else
                            If f1 = False Then
                                MsgBox "間違った店舗が入力されています"
                            End If
                            If f2 = False Then
                                MsgBox "間違った商品番号が入力されています"
                            End If
                        End If
                    End If
                Next j
            End If
            i = i + 1
        Wend
    End With
End Sub

在庫管理の在庫の列と、合計のところにある入庫、出庫、在庫の列はワークシート関数で作ってもらい、

ここでは店舗の出庫だけを拾ってくるようにしました。

店舗を増やす場合は、合計が端にあったほうがいいような気がするので右端ではなく合計の前か途中にしています。


運用するにあたりちょっと考えたのは返品して違う商品を買った場合はそれぞれを別の行に書くようにしなければ

在庫が合わなくなりますね。


動作は確認してますが、不具合がありました修正いたします。

id:icta

> SALINGERさん

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

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

サンプルデータでは問題なく動作したのですが、実際のデータではサンプルのようにうまく行きません。

恐らく「来店記録」の売上列と商品番号列が何列目というように固定されているのではないかと思います。

実際のデータはほぼサンプルデータと同じ列位置なのですが、若干異なるデータ列が含まれています。

サンプルにない行を削除すると動作しました。

できれば将来的に新しい列を追加するなどの必要性に迫られた時、柔軟に対応できるようにしたいと思います。

列数固定ではなく、マクロ実行後に1行目1列目から1行目を検索し、売上列、商品番号列が何列目にあるか調べ、列の位置を変数に保存できればと大変便利です。

位置を示す変数がコードの上の方に集められていればどこをカスタマイズすれば一目瞭然で、ワークシートの位置を多少変更しても問題なく動作します。※ただしワークシートの変更は列にとどめタイトル行は必ず1行目にあるものとします。

「在庫管理」に関しても商品番号と商品名を見やすくするためカテゴリ別に分けたり、商品のライフサイクルを追うため商品の初回購入日を入れることが考えられます。

そのため上記と同じように店舗のある行をtenpo_gyou = 3 '店舗の記載されている行 のように変数で指定できたりすると大変使いやすくなります。

商品番号に関してもshouhin_retsu = 1 '商品番号の記載されている列※”商品番号”の下より商品番号が始まる のようになっていると位置にとらわれず表の見栄えを調整できるため在庫を管理しやすくなると思います。

コードが複雑に長くなってしまうと思いますが、今後の柔軟な運用のためにお力をお借りできれば幸いです。

「来店記録」

※1行目は必ずタイトル行なので、1行目を検索し、目的の文字列がどこにあるか調べ変数に位置を保存。

「在庫管理」

※テキスト"店舗"を3行目、商品番号の位置を判定するテキスト"商品番号"を追加

※現状では在庫数がわかりづらいため商品番号の前の列にカテゴリや初回入庫日を入れることがあるかもしれません。

開始日 2008/5/10            

終了日 2008/5/12            

店舗  代官山   原宿   中華街   合計  

商品番号 商品名 入庫 出庫 在庫 入庫 出庫 在庫 入庫 出庫 在庫 入庫 出庫 在庫

A080102 XXカットソー 3 1 2 4  4 1  1 8 1 7

A080201 IITシャツ 4 1 3 3  3 2  2 9 1 8

A080607 OOキャミ2 5 1 4 4 1 3 4  4 13 2 11

C080402 JJジャケット3 6  6 3 1 2 6  6 15 1 14

D070604 VVパンツM 7 1 6 4  4 8  8 19 1 18

D080601 EEパンツ2 3  3 3 1 2 0  0 6 1 5

F080203 GGショール 4 1 3 4  4 2  2 10 1 9

F080706 ZZサンダル 5  5 3  3 4 2 2 12 2 10

G080701 PPバッグ 6  6 4  4 6 1 5 16 1 15

H080601 UUネックレス 7 1 6 3  3 8 1 7 18 2 16

H080701 LLリング 3  3 4  4 1 1 0 8 1 7

J080703 RRストール赤 4 -1 5 3  3 2 1 1 9 0 9


エラーメッセージを2種類用意していただいてありがとうございました。

エラーメッセージの必要性にまったく気がつきませんでした。

実際のデータで試したらエラーメッセージの連続で計算がなかなか先に進みませんでした。

過去のデータは手作業で処理していたためエラーが非常に多いと思います。

エラー箇所を人の手によって探すのは非常に困難です。

そのためマクロでエラー箇所をチェックし、書き出す機能を盛り込むことは可能でしょうか?


■エラー対処の仕様

※よい計算方法が思いつかないのでもっと良い方法があると思います。

※"店舗"行、"商品番号"列は検索または列数を変数に入れることでカスタマイズを簡単にする。

○店舗名を間違えた場合

「来店記録」でのカウント終了後、「在庫管理」に出庫数を書き出し時にもし"店舗"行に存在しない店舗名がカウントされていたらその店舗名を配列に保存していく。

出庫数書き出し終了後に「来店記録」の"店舗"列から配列に入れた存在しない店舗を順に検索する。

一致する行数の位置を配列に保存していき、検索が終わったら「在庫管理」の"商品番号"行の最終行から1行空けて表示。

J080703 RRストール赤 4 -1 5 3  3 2 1 1 9 0 9

間違った店舗が入力されています。

親宿 14358行

土野 3556行

○商品番号を間違えた場合

「来店記録」でのカウント終了後、「在庫管理」に出庫数を書き出し時にもし"商品番号"列に存在しない商品番号がカウントされていたらその商品番号を配列に保存していく。

出庫数書き出し終了後に「来店記録」の"商品番号"列から配列に入れた存在しない商品番号を順に検索する。

一致する行数の位置を配列に保存していき、検索が終わったら「在庫管理」の"商品番号"行の最終行から1行空けて表示。

J080703 RRストール赤 4 -1 5 3  3 2 1 1 9 0 9

間違った商品番号が入力されています。

J080701 ○○行

A090701 ○○行

E010101 ○○行


後からの機能追加で申し訳ありません。

この店舗別の在庫管理が今回の改善でいちばんやりたかったことなのです。

お知恵とお力をお借りできれば幸いです。

2008/05/17 08:17:17
id:SALINGER No.2

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

行がずれてたりすると、商品や店舗が見つからずメッセージボックスが全部出てしまいましたね。

エラーを想定していろいろと改造してみました。


基本的に、シートの改変によるエラーはメッセージボックスで、

入力のミスは、在庫管理の下に表示するようにしました。

付け加えた機能としては、開始日と終了日は、場所を変えることを想定して、その文字のあるセルの右隣のセルとして、

日付以外を入力した場合エラーがでるようにしました。


それから、間違った店舗が入っていた場合に、その行の商品番号の数だけエラーが出るのは仕様で

商品一つ一つで店舗の確認をするためです。

Sub SyukkoCount()
    Dim lastRow As Long         '在庫管理の最終行
    Dim i As Integer
    Dim j As Integer
    Dim k As Integer
    Dim r As Long
    Dim c As Integer
    Dim d As Date
    Dim hairetu() As String     '複数の商品番号を格納
    Dim f1 As Boolean
    Dim f2 As Boolean
    Dim kosuu As Integer        '×2など表示されていいた場合の個数
    Dim kakeru As Integer       '商品番号で×が出て来る位置
    Dim tenpo As Integer        '来店記録の店舗の列
    Dim raitenbi As Integer     '来店記録の来店日の列
    Dim uriage As Integer       '来店記録の売上の列
    Dim shyouhin As Integer     '来店記録の商品番号の列
    Dim startDay As Date        '開始日
    Dim endDay As Date          '終了日
    Dim ra As Range
    Dim hTenpo() As String      '店舗のエラーを記録
    Dim hSyouhin() As String    '商品番号のエラーを記録
    Dim r2 As Long
    
    ReDim hTenpo(1, 0) As String
    ReDim hSyouhin(1, 0) As String
    
    '定数、環境によって変更
    Const tenpo_gyou As Integer = 3         '在庫管理の店舗の行
    Const shouhin_retsu  As Integer = 1     '在庫管理の商品番号の列
    Const midasi_gyou As Integer = 1        '来店記録の見出しの行
    
    With Worksheets("来店記録")
        For i = 1 To 256
            If .Cells(midasi_gyou, i).Value = "店舗" Then
                tenpo = i
                Exit For
            End If
        Next i
        For i = 1 To 256
            If .Cells(midasi_gyou, i).Value = "来店日" Then
                raitenbi = i
                Exit For
            End If
        Next i
        For i = 1 To 256
            If .Cells(midasi_gyou, i).Value = "売上" Then
                uriage = i
                Exit For
            End If
        Next i
        For i = 1 To 256
            If .Cells(midasi_gyou, i).Value = "商品番号" Then
                shyouhin = i
                Exit For
            End If
        Next i
        If tenpo * raitenbi * uriage * shyouhin = 0 Then
            MsgBox "適切な来店記録の見出行を指定してください"
            Exit Sub
        End If
    End With
    
    With Worksheets("在庫管理")
        '開始日と終了日を取得
        Set ra = Worksheets("在庫管理").Cells.Find("開始日")
        If ra Is Nothing Then
            MsgBox "開始日が見つかりません"
            Exit Sub
        Else
            If IsDate(ra.Offset(0, 1).Value) Then
                startDay = ra.Offset(0, 1).Value
            Else
                MsgBox "開始日の右に正しい日付を入力してください"
                Exit Sub
            End If
        End If
        Set ra = Worksheets("在庫管理").Cells.Find("終了日")
        If ra Is Nothing Then
            MsgBox "終了日が見つかりません"
            Exit Sub
        Else
            If IsDate(ra.Offset(0, 1).Value) Then
                endDay = ra.Offset(0, 1).Value
            Else
                MsgBox "終了日の右に正しい日付を入力してください"
                Exit Sub
            End If
        End If
            
        '在庫管理が何行目まであるかを調べる
        lastRow = tenpo_gyou + 2
        While .Cells(lastRow, shouhin_retsu).Value <> ""
            lastRow = lastRow + 1
        Wend
        lastRow = lastRow - 1
        
        '出庫のクリア
        .Activate
        For i = 3 To 256
            If .Cells(tenpo_gyou + 1, i).Value = "出庫" And .Cells(tenpo_gyou, i - 1) <> "合計" Then
                .Range(Cells(tenpo_gyou + 2, i), Cells(lastRow, i)).Clear
            End If
        Next i
        
        i = midasi_gyou + 1
        While Worksheets("来店記録").Cells(i, shyouhin).Value <> ""
            d = Worksheets("来店記録").Cells(i, raitenbi).Value
            If startDay <= d And endDay >= d Then
                hairetu = Split(Worksheets("来店記録").Cells(i, shyouhin).Value, ",")
                For j = 0 To UBound(hairetu)
                    If hairetu(j) <> "" Then
                        kosuu = 1
                        kakeru = InStr(1, hairetu(j), "×")
                        If kakeru > 0 Then
                            kosuu = CInt(Mid(hairetu(j), kakeru + 1))
                            hairetu(j) = Mid(hairetu(j), 1, kakeru - 1)
                        End If
                        
                        f1 = False
                        f2 = False
                        For r = tenpo_gyou + 2 To lastRow
                            If .Cells(r, shouhin_retsu).Value = hairetu(j) Then
                                f1 = True
                                Exit For
                            End If
                        Next r
                        For c = 3 To 256
                            If .Cells(tenpo_gyou, c).Value = Worksheets("来店記録").Cells(i, tenpo).Value Then
                                f2 = True
                                Exit For
                            End If
                        Next c
                        
                        If f1 = True And f2 = True Then
                            If Worksheets("来店記録").Cells(i, uriage).Value >= 0 Then
                                .Cells(r, c + 1).Value = .Cells(r, c + 1).Value + kosuu
                            Else
                                .Cells(r, c + 1).Value = .Cells(r, c + 1).Value - kosuu
                            End If
                        Else
                            If f1 = False Then
                                ReDim Preserve hSyouhin(1, UBound(hSyouhin, 2) + 1)
                                hSyouhin(0, UBound(hSyouhin, 2)) = hairetu(j)
                                hSyouhin(1, UBound(hSyouhin, 2)) = i
                            End If
                            If f2 = False Then
                                ReDim Preserve hTenpo(1, UBound(hTenpo, 2) + 1)
                                hTenpo(0, UBound(hTenpo, 2)) = Worksheets("来店記録").Cells(i, tenpo).Value
                                hTenpo(1, UBound(hTenpo, 2)) = i
                            End If
                        End If
                    End If
                Next j
            End If
            i = i + 1
        Wend
        
        '前のエラーのクリア
        lastRow = lastRow + 1
        .Range(Cells(lastRow, 1), Cells(65536, 1)).Clear
        
        'エラーの表示
        If UBound(hTenpo, 2) > 0 Then
            lastRow = lastRow + 1
            .Cells(lastRow, 1).Value = "間違った店舗が入力されています。"
            lastRow = lastRow + 1
            For i = 1 To UBound(hTenpo, 2)
                .Cells(lastRow, 1).Value = hTenpo(0, i) & " " & hTenpo(1, i) & "行"
                lastRow = lastRow + 1
            Next i
        End If
        
        If UBound(hSyouhin, 2) > 0 Then
            lastRow = lastRow + 1
            .Cells(lastRow, 1).Value = "間違った商品番号が入力されています。"
            lastRow = lastRow + 1
            For i = 1 To UBound(hSyouhin, 2)
                .Cells(lastRow, 1).Value = hSyouhin(0, i) & " " & hSyouhin(1, i) & "行"
                lastRow = lastRow + 1
            Next i
        End If
        
    End With
End Sub
id:icta

> SALINGERさん

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

サンプルデータでは希望通りの動作を確認しました。

これだけ長いコードはさぞお時間がかかったことと思います。

機能の追加にも快く応じていただきありがとうございました。

サンプルではうまく行ったのですが、実際の運用で困ったことが起きました。

「来店記録」の商品番号欄列に1個でも空白があると出庫数がまったく表示されません。

これは恐らく仕様なのではないかと思うのですが、実は商品番号欄はこれまで記録を徹底してこなかったため過去のデータでは抜けているところがあります。

杜撰な在庫管理を改める今回の改善なので過去の商品番号が存在しないデータでも対応できるようにご変更願えませんでしょうか?

何度もお手数ばかりおかけして申し訳ありません。

また別件ですがhttp://q.hatena.ne.jp/1210987314に新しい質問を投稿しました。

もしお時間のご都合がつけばご覧になってみてください。

2008/05/17 15:42:48
id:SALINGER No.3

SALINGER回答回数3454ベストアンサー獲得回数9692008/05/17 16:58:44ここでベストアンサー

ポイント500pt

来店記録の商品番号の列に空白がでるまで処理を実行するように作っています。

それで、途中空白があっても最終行まで処理するようにちょっとだけ変更しました。

Sub SyukkoCount()
    Dim lastRow As Long         '在庫管理の最終行
    Dim lastRow2 As Long        '顧客名簿の最終行
    Dim i As Integer
    Dim j As Integer
    Dim k As Integer
    Dim r As Long
    Dim c As Integer
    Dim d As Date
    Dim hairetu() As String     '複数の商品番号を格納
    Dim f1 As Boolean
    Dim f2 As Boolean
    Dim kosuu As Integer        '×2など表示されていいた場合の個数
    Dim kakeru As Integer       '商品番号で×が出て来る位置
    Dim tenpo As Integer        '来店記録の店舗の列
    Dim raitenbi As Integer     '来店記録の来店日の列
    Dim uriage As Integer       '来店記録の売上の列
    Dim shyouhin As Integer     '来店記録の商品番号の列
    Dim startDay As Date        '開始日
    Dim endDay As Date          '終了日
    Dim ra As Range
    Dim hTenpo() As String      '店舗のエラーを記録
    Dim hSyouhin() As String    '商品番号のエラーを記録
    Dim r2 As Long
    
    ReDim hTenpo(1, 0) As String
    ReDim hSyouhin(1, 0) As String
    
    '定数、環境によって変更
    Const tenpo_gyou As Integer = 3         '在庫管理の店舗の行
    Const shouhin_retsu  As Integer = 1     '在庫管理の商品番号の列
    Const midasi_gyou As Integer = 1        '来店記録の見出しの行
    
    With Worksheets("来店記録")
        For i = 1 To 256
            If .Cells(midasi_gyou, i).Value = "店舗" Then
                tenpo = i
                Exit For
            End If
        Next i
        For i = 1 To 256
            If .Cells(midasi_gyou, i).Value = "来店日" Then
                raitenbi = i
                Exit For
            End If
        Next i
        For i = 1 To 256
            If .Cells(midasi_gyou, i).Value = "売上" Then
                uriage = i
                Exit For
            End If
        Next i
        For i = 1 To 256
            If .Cells(midasi_gyou, i).Value = "商品番号" Then
                shyouhin = i
                Exit For
            End If
        Next i
        If tenpo * raitenbi * uriage * shyouhin = 0 Then
            MsgBox "適切な来店記録の見出行を指定してください"
            Exit Sub
        End If
    End With
    
    With Worksheets("在庫管理")
        '開始日と終了日を取得
        Set ra = Worksheets("在庫管理").Cells.Find("開始日")
        If ra Is Nothing Then
            MsgBox "開始日が見つかりません"
            Exit Sub
        Else
            If IsDate(ra.Offset(0, 1).Value) Then
                startDay = ra.Offset(0, 1).Value
            Else
                MsgBox "開始日の右に正しい日付を入力してください"
                Exit Sub
            End If
        End If
        Set ra = Worksheets("在庫管理").Cells.Find("終了日")
        If ra Is Nothing Then
            MsgBox "終了日が見つかりません"
            Exit Sub
        Else
            If IsDate(ra.Offset(0, 1).Value) Then
                endDay = ra.Offset(0, 1).Value
            Else
                MsgBox "終了日の右に正しい日付を入力してください"
                Exit Sub
            End If
        End If
            
        '在庫管理が何行目まであるかを調べる
        lastRow = tenpo_gyou + 2
        While .Cells(lastRow, shouhin_retsu).Value <> ""
            lastRow = lastRow + 1
        Wend
        lastRow = lastRow - 1
        
        lastRow2 = Worksheets("来店記録").Cells(Rows.Count, shyouhin).End(xlUp).Row
        '出庫のクリア
        .Activate
        For i = 3 To 256
            If .Cells(tenpo_gyou + 1, i).Value = "出庫" And .Cells(tenpo_gyou, i - 1) <> "合計" Then
                .Range(Cells(tenpo_gyou + 2, i), Cells(lastRow, i)).Clear
            End If
        Next i
        
        For i = midasi_gyou + 1 To lastRow2
            d = Worksheets("来店記録").Cells(i, raitenbi).Value
            If startDay <= d And endDay >= d Then
                hairetu = Split(Worksheets("来店記録").Cells(i, shyouhin).Value, ",")
                For j = 0 To UBound(hairetu)
                    If hairetu(j) <> "" Then
                        kosuu = 1
                        kakeru = InStr(1, hairetu(j), "×")
                        If kakeru > 0 Then
                            kosuu = CInt(Mid(hairetu(j), kakeru + 1))
                            hairetu(j) = Mid(hairetu(j), 1, kakeru - 1)
                        End If
                        
                        f1 = False
                        f2 = False
                        For r = tenpo_gyou + 2 To lastRow
                            If .Cells(r, shouhin_retsu).Value = hairetu(j) Then
                                f1 = True
                                Exit For
                            End If
                        Next r
                        For c = 3 To 256
                            If .Cells(tenpo_gyou, c).Value = Worksheets("来店記録").Cells(i, tenpo).Value Then
                                f2 = True
                                Exit For
                            End If
                        Next c
                        
                        If f1 = True And f2 = True Then
                            If Worksheets("来店記録").Cells(i, uriage).Value >= 0 Then
                                .Cells(r, c + 1).Value = .Cells(r, c + 1).Value + kosuu
                            Else
                                .Cells(r, c + 1).Value = .Cells(r, c + 1).Value - kosuu
                            End If
                        Else
                            If f1 = False Then
                                ReDim Preserve hSyouhin(1, UBound(hSyouhin, 2) + 1)
                                hSyouhin(0, UBound(hSyouhin, 2)) = hairetu(j)
                                hSyouhin(1, UBound(hSyouhin, 2)) = i
                            End If
                            If f2 = False Then
                                ReDim Preserve hTenpo(1, UBound(hTenpo, 2) + 1)
                                hTenpo(0, UBound(hTenpo, 2)) = Worksheets("来店記録").Cells(i, tenpo).Value
                                hTenpo(1, UBound(hTenpo, 2)) = i
                            End If
                        End If
                    End If
                Next j
            End If
        Next i
        
        '前のエラーのクリア
        lastRow = lastRow + 1
        .Range(Cells(lastRow, 1), Cells(65536, 1)).Clear
        
        'エラーの表示
        If UBound(hTenpo, 2) > 0 Then
            lastRow = lastRow + 1
            .Cells(lastRow, 1).Value = "間違った店舗が入力されています。"
            lastRow = lastRow + 1
            For i = 1 To UBound(hTenpo, 2)
                .Cells(lastRow, 1).Value = hTenpo(0, i) & " " & hTenpo(1, i) & "行"
                lastRow = lastRow + 1
            Next i
        End If
        
        If UBound(hSyouhin, 2) > 0 Then
            lastRow = lastRow + 1
            .Cells(lastRow, 1).Value = "間違った商品番号が入力されています。"
            lastRow = lastRow + 1
            For i = 1 To UBound(hSyouhin, 2)
                .Cells(lastRow, 1).Value = hSyouhin(0, i) & " " & hSyouhin(1, i) & "行"
                lastRow = lastRow + 1
            Next i
        End If
        
    End With
End Sub
id:icta

> SALINGERさん

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

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

これで念願だった在庫管理ができそうです。

スタッフにも喜んでもらえそうです。

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

2008/05/17 18:12:10
  • id:icta
    これはhttp://q.hatena.ne.jp/1210836514,http://q.hatena.ne.jp/1210860623の派生質問です。
    データを記録するのはエクセルの知識がほとんどない販売スタッフです。データベースソフトを使えればよいのですが以前業者に依頼したものは導入に失敗しました。作業が煩雑になったのと各店舗に散らばるスタッフへの教育が難しく変更に対応できなかったためです。
    そのため現行作業をあまり変えることなく行うのが今回の方針です。


    「来店記録」

    店舗 会員番号 旧会員番号 会員資格 名前 フリガナ 来店日 担当 売上 商品名 商品番号
    新宿 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×2,
    上野 C01329 1329 正 川畑 カワハタ 2008/5/11 吉田 15000 LLリング,UUネックレス H080701,H080601
    上野 D00638 D638 正 長浜 ナガハマ 2008/5/11 吉田 6000 RRストール赤 J080703
    新宿 D00638 D638 正 長浜 ナガハマ 2008/5/12 長岡 -6000 RRストール赤 J080703
    新宿 C03825 3825 正 山内 ヤマウチ 2008/5/12 吉田 12000 OOキャミ2,UUネックレス A080607,H080601


    「商品リスト」

    カテゴリ 商品番号 商品名
    トップス 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ストール赤


    「在庫管理」

    開始日 2008/1/1            
    終了日 2008/6/30            
      新宿   原宿   上野   合計  
      入庫 出庫 在庫 入庫 出庫 在庫 入庫 出庫 在庫 入庫 出庫 在庫
    A080102 XXカットソー 3 2 1 4 0 4 1 0 1 8 2 6
    A080201 IITシャツ 4 0 4 3 2 1 2 2 0 9 4 5
    A080607 OOキャミ2 5 1 4 4 1 3 4 1 3 13 3 10
    C080402 JJジャケット3 6 2 4 3 0 3 6 5 1 15 7 8
    D070604 VVパンツM 7 2 5 4 3 1 8 2 6 19 7 12
    D080601 EEパンツ2 3 1 2 3 2 1 0 0 0 6 3 3
    F080203 GGショール 4 0 4 4 4 0 2 1 1 10 5 5
    F080706 ZZサンダル 5 0 5 3 1 2 4 2 2 12 3 9
    G080701 PPバッグ 6 2 4 4 0 4 6 1 5 16 3 13
    H080601 UUネックレス 7 3 4 3 2 1 8 2 6 18 7 11
    H080701 LLリング 3 1 2 4 1 3 1 0 1 8 2 6
    J080703 RRストール赤 4 4 0 3 2 1 2 1 1 9 7 2


    ■仕様

    ○概要
    「在庫管理」の開始日、終了日を設定し、マクロを実行する。
    「来店記録」の来店日列を参照し、開始日から終了日までの間、商品番号列にある商品番号のカウントを店舗別に行う。
    売上列でマイナスの売上は返品を意味し、出庫から1減らす。
    すべての商品のカウントを終えたら、「在庫管理」で該当する商品番号と店舗の出庫数から差し引く。

    ○詳細
    「在庫管理」
    各店舗の入庫数は事前に記録してある。
    店舗は増えたら3行目の右端に増やしていく。
    店舗名の直下にその店舗の入庫数が記載されている。
    入庫-出庫=在庫である。在庫の列には左の計算式が入っている。
    1列目に開始日と終了日があり右隣のセルに各々の日付を設定する。
    「来店記録」
    商品番号列に商品番号がカンマ区切りで記録されている。
    売上列でマイナスの売上は返品を表す。この場合、出庫の数字を-1にする。
    F080706×2,はF080706が2個購入されたことを表す。バーコードリーダーを使うとこのようなことは起きないが、過去のデータがこのようになっており、スタッフが過去のやり方を踏襲することも想定する。最後のカンマも本来付かないが過去のデータの一部がこのようになっているため。

    「在庫管理」の開始日、終了日を設定し、マクロを実行する。
    「来店記録」の来店日列を参照し、開始日から終了日までの間、商品番号列にあるカンマ区切りされた商品番号のカウントを店舗列に記載された各店舗別に行う。
    カウントは売上がプラスのときは+1、売上がマイナスのときは返品なので-1とする。
    期間内のすべての商品についてカウントを終えたら「在庫管理」から該当する商品番号と店舗の出庫数からカウント分を差し引く。

    ○実際の運用
    1)「在庫管理」の開始日、終了日を設定し、マクロを実行
    開始日 2008/5/10
    終了日 2008/5/12

    2)「来店記録」来店日列の期間内で商品番号列から商品番号をカウントし、「在庫管理」の出庫を差し引く。
    開始日 2008/5/10
    終了日 2008/5/12
      新宿   原宿   上野   合計  
      入庫 出庫 在庫 入庫 出庫 在庫 入庫 出庫 在庫 入庫 出庫 在庫
      新宿   原宿   上野   合計  
      入庫 出庫 在庫 入庫 出庫 在庫 入庫 出庫 在庫 入庫 出庫 在庫
    A080102 XXカットソー 3 3 0 4 0 4 1 0 1 8 3 5
    A080201 IITシャツ 4 1 3 3 2 1 2 2 0 9 5 4
    A080607 OOキャミ2 5 2 3 4 2 2 4 1 3 13 5 8
    C080402 JJジャケット3 6 2 4 3 1 2 6 5 1 15 8 7
    D070604 VVパンツM 7 3 4 4 3 1 8 2 6 19 8 11
    D080601 EEパンツ2 3 1 2 3 3 0 0 0 0 6 4 2
    F080203 GGショール 4 1 3 4 4 0 2 1 1 10 6 4
    F080706 ZZサンダル 5 0 5 3 1 2 4 4 0 12 5 7
    G080701 PPバッグ 6 2 4 4 0 4 6 2 4 16 4 12
    H080601 UUネックレス 7 4 3 3 2 1 8 3 5 18 9 9
    H080701 LLリング 3 1 2 4 1 3 1 1 0 8 3 5
    J080703 RRストール赤 4 3 1 3 2 1 2 2 0 9 7 2

  • id:SALINGER
    >すべての商品のカウントを終えたら、「在庫管理」で該当する商品番号と店舗の出庫数から差し引く。
    ここのところなんですが、出庫というのは売れた数だと思うので、カウントした数をそのまま
    出庫のところに載せてはだめなのでしょうか?
  • id:icta
    > ここのところなんですが、出庫というのは売れた数だと思うので、カウントした数をそのまま出庫のところに載せてはだめなのでしょうか?

    大変申し訳ありません。チェックしたつもりだったのですがこれは記載の誤りです。カウントした数をそのまま出庫のところに記載します。
    お手数を煩わせて申し訳ありませんでした。
  • id:icta
    上記回答で「間違った店舗が入力されています」「間違った商品番号が入力されています」の上に一行空けて記載したのですが反映されませんでした。実際は見やすくするため最終行から1行空けます。

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

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

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

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