エクセルでの集計、抽出

こんなのではどうでしょうか？
初期設定のConst部を指定してください。
Sub sample()
'初期設定
Const 表1 = "A1" '表１の左上のセル（「ロット」の文字のセル）
Const 表2 = "D1" '表２の左上のセル（「仕込量（ｋｇ）」の結合セル範囲の左のセル）
Const 表2データ部 = "E4:L9" '表２のデータ（黄色）の部分のセル（クリアのため）

Dim r1 As Integer
Dim c1 As Integer
Dim r2 As Integer
Dim c2 As Integer
Dim r2ofs As Integer
Dim 仕込量 As Integer
Dim 数量 As Integer
Dim data As Integer
'表２クリア
Range(表2データ部).ClearContents
'注目点の初期位置に移動
r1 = Range(表1).Row '=r1+1-1(最初に数量を読み込むための移動を考慮)
c1 = Range(表1).Column + 1
r2 = Range(表2).Row + 2
c2 = Range(表2).Column - 1 '=c2+1-2(最初に仕込量を読み込むための移動を考慮)
'開始
Do
If 数量 = 0 Then
r1 = r1 + 1 '次の数量の行
If Cells(r1, c1) = 0 Then Exit Do '数量が無いなら終わり
数量 = Cells(r1, c1)
End If
If 仕込量 = 0 Then
c2 = c2 + 2 '次の仕込量の列
If Cells(r2, c2) = 0 Then Exit Do '仕込量が無いなら終わり
仕込量 = Cells(r2, c2)
r2ofs = 1 '表２の新しい列に書くため、行方向のr2からのオフセットを初期化
End If
Cells(r2 + r2ofs, c2) = Cells(r1, c1 - 1) ' ロットを表示
data = IIf(数量 <= 仕込量, 数量, 仕込量) '表示値を取得
Cells(r2 + r2ofs, c2 + 1) = data
仕込量 = 仕込量 - data
数量 = 数量 - data
r2ofs = r2ofs + 1
Loop
End Sub

仕込量（ピンク）の部分に入力があったら変更する場合です。
"E3:L3"は表示に合わせて変更してください。
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Range("E3:L3"), Target) Is Nothing Then
sample
End If
End Sub

投稿日時 - 2008-04-02 19:26:38

かって同じような質問があったときに、作成したプログラムがあります。6つのマクロを使っています。6キロバイトになるので、ここには表しか載せられません。どうしたらよいでしょうか。
シート1　表1
ろっとＮｏ　　生産量在庫量受注ＩＤ受注量積出量残量myrowmyrowendmyrowprtstmyrowprtend
0712104-1111526056
07121110-1
07121220-12204
07121354310
071214888
計算開始行計算終了行出荷テーブルプリント開始行


しーと2　表2
受注ＩＤ受注量ロットＮｏ生産量出荷量
11507121044
0712111010
071212201
2200712122019
07121351

投稿日時 - 2008-04-02 15:28:16