http://okwave.jp/qa3915562.html

こんなファイルだとします。

 ピンク色のところが変わったら、黄色いところを自動的に集計する。。。こないだやったイベントですね（＾＾）

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Row = 4 And (Target.Column = 5 Or Target.Column = 7 Or Target.Column = 9 Or Target.Column = 11) Then
        MsgBox ("ピンクのところが変わったよ")
    End If
End Sub

Targetで、変わったところを判断して、４行目でかつ、（EまたはGまたはIまたはK）が変わったらメッセージ、と。

 ピンクのところを変えてみると

ん、おっけい。

ピンクが変わったら何をするか？下の集計を行う前に、いったん黄色のところを全部消しましょう。

 これもやったばっかり（＾＾）

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Row = 4 And (Target.Column = 5 Or Target.Column = 7 Or Target.Column = 9 Or Target.Column = 11) Then
        ActiveSheet.Range("E5:L10").Clear
    End If
End Sub

範囲を指定して　.Clear　でクリアーです。ピンクの値を変えてみると。。。

（＾＾；）値は消えましたが、罫線や背景色も消えちゃいました（＾＾；）

値だけ消したいんだけど、どうすればよいかな。。。

Yahoo!で、「Excel セル 値を消去」で検索すると、こちらのページが見つかりました。

 .ClearContentsで消せばいいみたいですね。

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Row = 4 And (Target.Column = 5 Or Target.Column = 7 Or Target.Column = 9 Or Target.Column = 11) Then
        ActiveSheet.Range("E5:L10").ClearContents
    End If
End Sub

 いったん値と罫線、背景色を戻します。 で、ピンクを変えてみます。

ん、おっけい（＾＾） 後は黄色の部分を作っていく、って事で。

 ここの考え方、結構複雑なので、とりあえずプログラムです。

Private Sub Worksheet_Change(ByVal Target As Range)
     Dim kaime As Integer
     Dim nokori_shikomiryou As Long
     Dim nokori_lotsuuryou As Long
     Dim suuryou As Long
     Dim imamiteru_lotnogyousuu As Integer
     Dim imano_kiironogyousuu As Integer
     'もし、ピンク色のところが変更されたら
     If Target.Row = 4 And (Target.Column = 5 Or Target.Column = 7 Or Target.Column = 9 Or Target.Column = 11) Then
         '黄色のところの値を全部クリアします。
         ActiveSheet.Range("E5:L10").ClearContents
         '表１を3行目（「A1」のロット）から見ていきます。
         imamiteru_lotnogyousuu = 3
         '1回目から見ていきます。
         kaime = 1
         '残りの仕込量を変数に代入
         nokori_shikomiryou = ActiveSheet.Cells(4, (kaime - 1) * 2 + 5)
         'ロットの数量を変数に代入
         nokori_lotsuuryou = ActiveSheet.Cells(imamiteru_lotnogyousuu, 2)
         '黄色の列の最初の値を5にします。
         imano_kiironogyousuu = 5
         Do
             'もし、残りの仕込量が0なら、終了
             If nokori_shikomiryou = 0 Then Exit Do
             'データの表示。ロット名の表示
             ActiveSheet.Cells(imano_kiironogyousuu, (kaime - 1) * 2 + 5).Value = ActiveSheet.Cells(imamiteru_lotnogyousuu, 1)
             'データの表示。数量の表示
             suuryou = IIf(nokori_shikomiryou >= nokori_lotsuuryou, nokori_lotsuuryou, nokori_shikomiryou)
             ActiveSheet.Cells(imano_kiironogyousuu, (kaime - 1) * 2 + 6).Value = suuryou
             '今表示した数量を、それぞれから引く
             nokori_shikomiryou = nokori_shikomiryou - suuryou
             nokori_lotsuuryou = nokori_lotsuuryou - suuryou
             imano_kiironogyousuu = imano_kiironogyousuu + 1
             'もし、仕込量が0なら次へ進む
             If nokori_shikomiryou = 0 Then
                 imano_kiironogyousuu = 5
                 kaime = kaime + 1
                 nokori_shikomiryou = ActiveSheet.Cells(4, (kaime - 1) * 2 + 5)
                 'もし、残りの仕込量が0なら、終了
                 If nokori_shikomiryou = 0 Then Exit Do
             End If
             'もし、ロットの残量がない場合、次のロットへ進む
             If nokori_lotsuuryou = 0 Then
                 imamiteru_lotnogyousuu = imamiteru_lotnogyousuu + 1
                 nokori_lotsuuryou = ActiveSheet.Cells(imamiteru_lotnogyousuu, 2)
                 'もし、ロットの数量が0の場合、もうロットがないので終了
                 If nokori_lotsuuryou = 0 Then
                     MsgBox ("全部のロットを使っても足りませんでした。")
                     Exit Do
                 End If
             End If
         Loop
     End If
End Sub

（＾＾；）今までで一番難しいかな？

手作業で黄色い部分を作っていく場合と考え方は同じなんですけどね。

終了判断をするところのプログラムがちょっと汚い感じですが。。。

もし、質問があれば、コメント欄でどぞ。ファイルはこちらにおいておきます。→vbastudy_21.xls