【excelマクロ】重複をチェックしてその行を削除・表を整頓するマクロ

会社で資材の在庫表を作成しているのですが、大変困っております。
マクロ初心者で技術不足なのでどうかご教授願います。
「資材受け入れシート」として、下の表があります。
　　 1　　　2　　 3　 4
　受入日　品名　 Lot　 数量
　　7/7 　　A　 BNR32　 10
　　7/8 　　A　 BNR32　 5
　　7/10 　 B　 SW200　 2
　　7/7 　　B　 AE860　 4
　　7/8 　　B　 SW200　 12
　　7/9 　　C　 GD300　 10
　　7/7 　　C　 GD300　 1
　　7/7 　　C　 DC200　 7
これを2列目「品名」をキーとして「Lot」を確認し、同じ（つまり同じ物）であればその行を削除して、数量を加算して1行にまとめるマクロを作りたいのです。ポイントは2列目「品名」の重複確認のみで行削除ではなく、3列目「Lot」も確認する必要があることと、削除してからその「品名」がある行に削除した「数量」分加算しなくてはいけないことだと考えております。
　　1　　　2　　 3　 4
　受入日　品名　 Lot　 数量
　　7/8 　　A　 BNR32　 15
　　7/10 　 B　 SW200　 14
　　7/7 　　B　 AE860　 4
　　7/9 　　C　 GD300　 11
　　7/7 　　C　 DC200　 7
「受入日」の所はできれば最終日になれば良いかなと思っています。
会社で期限を決められているのですが、手こずってしまい前へ進みません。説明が分かりづらいかもしれませんが、どうか宜しくお願いいたします。

No.4 ベストアンサー 回答者： Tetralemma 回答日時： 2007/07/16 02:42

どうも「ソート」という表現はふさわしくないようです。

「サマリ」に訂正します。
ついでに、受入日の最終日の取得を追加しました。
'----------------------------
'重複データのサマリ
'----------------------------
Sub SortData()

Dim rowMax As Integer
Dim row6Max As Integer

Dim i, j, k As Integer
Dim Hinmei As String
Dim Hizuke As String
Dim suu As Integer
Dim flg As Boolean 'データ一致フラグ

'データ行数
rowMax = CountRow()

Cells(1, 6) = Cells(1, 1)
Cells(1, 7) = Cells(1, 2)
Cells(1, 8) = Cells(1, 3)
Cells(1, 9) = Cells(1, 4)
'最初に品名+Lotのサマリを作成　11列目に書き出し
k = 2
For j = 2 To rowMax
Hinmei = Cells(j, 2) + Cells(j, 3) '品名+Lotを取得
flg = False
'11列目の品名+Lotと比較
For i = 2 To rowMax
If Hinmei = Cells(i, 11) Then
flg = True '一致
Exit For
End If
Next i
If flg = False Then '一致しない場合
Cells(k, 11) = Hinmei '11列目へ品名を格納
Cells(k, 6).NumberFormat = "MM/dd" '書式を設定
Cells(k, 6) = Cells(j, 1)
Cells(k, 7) = Cells(j, 2)
Cells(k, 8) = Cells(j, 3)
k = k + 1 '11列目の行数
End If
Next j

row11Max = k - 1 '品名+Lotのサマリ件数

For k = 2 To row11Max
Hinmei = Cells(k, 11) '11列目の品名+Lotを取得
Hizuke = Cells(k, 6) '6列目の日付を取得
suu = 0
For j = 2 To rowMax
If Hinmei = Cells(j, 2) + Cells(j, 3) Then '品名+Lotと比較
suu = suu + Cells(j, 4)
If Hizuke < Cells(j, 1) Then
Hizuke = Cells(j, 1) '日付を取得
Cells(k, 6) = Hizuke '6列目へ日付を設定
End If
End If
Next j
Cells(k, 9) = suu '数量を9列目へ格納
Next k

End Sub
'---------------------------------------------------
「受入日」の所は、ちょっと難しいので、補足しましょう。
日付の比較は注意が必要です。
セルの書式が標準となっていると、数値として扱われるからです。
数値と日付を比較すると、正しく比較できないため、
NumberFormatで、書式を日付に変更しています。
下記の記述がとても大事です。
Cells(k, 6).NumberFormat = "MM/dd" '書式を設定

最後に、このプログラムは１度実行すると、２度目はそのままでは
ただしく動作しません。
２度目以降は、6列目から11列目までをクリアしてください。
これは初期化の問題ですが、そこは省略させていただきました。

この回答へのお礼

Tetralemma様、数回に亘って詳しいご説明ありがとうございました。
当方、マクロ初心者ですので印刷して解析しながら勉強しているところです。大変参考になりました。本当にありがとうございました。

お礼日時：2007/07/17 19:21

No.3 回答者： Tetralemma 回答日時： 2007/07/16 01:39

先ほどの１は、よく観たら間違ってますね。

大変失礼しました。以下に正しいソースを再掲載します。

Function CountRow()

Dim suu As Integer
Dim i As Integer

i = 1 'カウンタ

'データのある行数をカウントする
Do
i = i + 1
suu = Cells(i, 4) '4列目の数量を取得
Loop While suu > 0

'MsgBox "i=" & i 'データ件数 + 1(次の行)

CountRow = i - 1

End Function

最後の値を返すところが抜けてました。

No.2 回答者： Tetralemma 回答日時： 2007/07/16 00:30

１．まずは、対象データの範囲を調べる機能、

２．次にソート機能が必要です。
３．それから、上から下へ重複を調べる機能、
４．重複したデータを、加算する機能、
５．加算した結果を、書き出す機能が必要ですね。

質問される場合は、このように、機能を分割して、その内、
１つか２つを質問された方が、回答していただけると思います。
とはいえ、お困りのようなので、ポイントだけ解説しましょう。
'-----------------------------------------
'１．対象データの範囲を調べる
'-----------------------------------------
Function CountRow()
Dim suu As Integer
Dim i As Integer
i = 1 'カウンタ
'データのある行数をカウントする
Do
i = i + 1
suu = Cells(i, 4)
Loop While suu > 0
'MsgBox "i=" & i 'ただしiはデータのある次の行
End Function

'-----------------------------------------
'２．ソート
'-----------------------------------------
Sub SortData()
Dim rowMax As Integer
Dim row6Max As Integer
Dim i, j, k As Integer
Dim Hinmei As String
Dim suu As Integer
Dim flg As Boolean 'データ一致フラグ

rowMax = CountRow() 'データ行数
'最初に品名+Lotのサマリを作成　6列目に書き出し
k = 2
For j = 2 To rowMax
Hinmei = Cells(j, 2) + Cells(j, 3) '品名+Lotを取得
flg = False
'6列目の品名+Lotと比較
For i = 2 To rowMax
If Hinmei = Cells(i, 6) Then
flg = True '一致
Exit For
End If
Next i
If flg = False Then '一致しない場合
Cells(k, 6) = Hinmei '6列目へ品名を格納
k = k + 1 '6列目の行数
End If
Next j
row6Max = k - 1 '品名のサマリ件数
For k = 2 To row6Max
Hinmei = Cells(k, 6) '6列目の品名+Lotを取得
suu = 0
For j = 2 To rowMax
If Hinmei = Cells(j, 2) + Cells(j, 3) Then '品名+Lotと比較
suu = suu + Cells(j, 4)
End If
Next j
Cells(k, 7) = suu '7列目へ格納
Next k
End Sub
'---------------------------------------
これでソートも合計も出来ました。
とりあえずここまで出来ればあとはなんとかなると思いますが？

No.1 回答者： sakusaker7 回答日時： 2007/07/15 19:28

お困りなのはわかりました。

で、どういった回答をお望みなのでしょうか?

考え方としてはあっていると思いますのでそのままプログラムとして書き出せばよいのではないでしょうか?
より具体的な部分でどう書いてよいかわからないというのであれば、その旨補足していただければ
アドバイスできるかもしれません。

プログラム(マクロ)を代わりに書いてくれという依頼であれば残念ながら
ご期待には添えません。

> ご教授願います。
こういう場合は「教示」を使います。