VBA 別シートが変更されたら表の在庫数を減らしたい

Question

前提・実現したいこと

Excelにて部品在庫管理のマクロをくんでいます。

『在庫』シートに在庫の表があり、B列に商品名、C/E/G/I列に商品の部品名・D/F/H/J列にそれぞれの部品の在庫数が記載されています。（商品の部品列が分けられているのは部品種類別の分類用です）
また『入荷履歴』シートB列に商品名、D列に部品名、F列に使用日付入力欄があります。

『入荷履歴』シートのF列・使用日付欄に日付を入力し、コマンドボタンを押したら『在庫』シートの表の該当する商品名の部品在庫を-1するマクロを組みたいです。（使用日付が入力されていない場合は引き算の処理をしない）

『在庫』シートの表は商品ごとに形式は変わらず（商品名・部品名・部品在庫数の列は変わらない）、また商品名は変わりますが各部品名は変わりません。

発生している問題・エラーメッセージ

With buhinkensaku～の部分が黄色くなり、オブジェクト変数またはWithブロック変数が設定されていませんとエラーが出ます。

該当のソースコード

Sub 入荷履歴_ボタン2_Click()
Dim hizuke As Range
Dim syouhin As Range
Dim buhin As Range
Dim syouhinkensaku As Range
Dim buhinkensaku

For Each hizuke In Sheets("入荷履歴").Range("F:F")
Set syouhin = Sheets("在庫").Range("B:B")
Set buhin = Sheets("在庫").Range("C:C,E:E,G:G,I:I")

If hizuke.Value <> "" Then
Set syouhinkensaku = syouhin.Find(what:=hizuke.Offset(0, -4), lookat:=xlWhole)
If Not syouhinkensaku is Nothing Then
Set buhinkensaku = buhin.Find(what:=hizuke.Offset(0, -2), lookat:=xlWhole)
With buhinkensaku.Offset(0, 1) 
.Value= .Value - 1
End With
End If
End If
Next


End Sub

ネットで色々検索してみたのですがよくわからず。。。
ネット知識をつなぎ合わせたコードなのでぐちゃぐちゃだと思いますが、ご教授いただければと思います。

Answer 1

＜修正＞
在庫シートでの商品の確認方法を変更してみました。

Sub 入荷履歴_ボタン2_Click()
    Dim buhin As Range
    Set buhin = Sheets("在庫").Range("C:C,E:E,G:G,I:I").SpecialCells(xlCellTypeConstants)
    
    Dim hizuke As Range
    
    For Each hizuke In Intersect(Sheets("入荷履歴").UsedRange, Sheets("入荷履歴").Range("F:F"))
        If hizuke.Value <> "" Then
            Dim s As String, b As String
            s = hizuke.Offset(0, -4).Value
            b = hizuke.Offset(0, -2).Value
            
            Dim c As Range, syouhin As Range
            
            For Each c In buhin
                Set syouhin = c.Offset(0, 2 - c.Column)
                If syouhin.Value = "" Then Set syouhin = syouhin.End(xlUp)
                If c.Value = b And syouhin.Value = s Then
                    c.Offset(0, 1).Value = c.Offset(0, 1).Value - 1
                    Exit For
                End If
            Next
        End If
    Next
End Sub

別の方法として、「まず該当商品を検索して、その行から次の商品の行の手前までをbuhinの範囲にする」とする手もあるかと思います。（その方が処理は速いかもしれません。）

Sub 入荷履歴_ボタン2_Click()
    Dim hizuke As Range
    Dim syouhin As Range
    Dim buhin As Range
    Dim syouhinkensaku As Range
    Dim buhinkensaku As Range
    
    For Each hizuke In Sheets("入荷履歴").Range("F:F")
    Set syouhin = Sheets("在庫").Range("B:B")
    Set buhin = Sheets("在庫").Range("C:C,E:E,G:G,I:I")
    
    If hizuke.Value <> "" Then
        Set syouhinkensaku = syouhin.Find(what:=hizuke.Offset(0, -4), lookat:=xlWhole)
        If Not syouhinkensaku Is Nothing Then
            Dim startRow, endRow
            startRow = syouhinkensaku.Row
            If syouhinkensaku.Offset(1).Value = "" Then
                endRow = syouhinkensaku.End(xlDown).Row - 1
            Else
                endRow = startRow
            End If
            Set buhin = Intersect(Sheets("在庫").Range(startRow & ":" & endRow), buhin)
                
            Set buhinkensaku = buhin.Find(what:=hizuke.Offset(0, -2), lookat:=xlWhole)
            If Not buhinkensaku Is Nothing Then
                With buhinkensaku.Offset(0, 1)
                    .Value = .Value - 1
                End With
            Else
                MsgBox "buhinkensaku Is Nothing"
            End If
        End If
    End If
    Next
End Sub

Comments

[nisvbv]

ご回答ありがとうございます。
試してみたのですが、うまく作動せず…

エラーは出ないのですが計算もされないといった感じです。
自分なりにもう少しいじってみます。

[jinoji]

B列は空白の行もありますか？

[nisvbv]

表のほうにはあります。
わかりにくい質問で申し訳ありません。画像を追加いたしました。

表は商品名だけ異なり、部品名・形式は同じものが複数存在すると考えていただければと思います。

[nisvbv]

返信遅くなり申し訳ありません。
思った通りの動きができました！
まことにありがとうございました。