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

質問

MC28SP 会社で資材の在庫管理表を作成しているのですが、大変困っております。
マクロ初心者で技術不足なのでどうかご教授願います。
「資材受け入れシート」として、下の表があります。
　　 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行にまとめるマクロを作りたいのです。ポイントは(1)2列目「品名」の重複確認のみで行削除ではなく、3列目「Lot」も確認する必要があることと、(2)削除してからその「品名」がある行に削除した「数量」分加算しなくてはいけないことだと考えているのですが・・・。
　　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

nicotinism · ベストアンサー

ご参考までにという事で。。。
標準モジュールで実行してみてください。

Sub test()
　　Dim strSql As String
　　Dim cnXL As Object
　　Dim rsXL As Object
　　Const adOpenForwardOnly = 0

　　Sheets("資材受け入れシート").Range("A1:D1").Copy
　　Sheets("資材受け入れシート").Paste Destination:=Worksheets("Sheet2").Range("A1:D1")
　　Application.CutCopyMode = False

　　Set cnXL = CreateObject("ADODB.Connection")
　　Set rsXL = CreateObject("ADODB.Recordset")

　　With cnXL
　　　　.Provider = "MSDASQL"
　　　　.ConnectionString = "Driver={Microsoft Excel Driver (*.xls)};" & _
　　　　"DBQ=" & ThisWorkbook.FullName & "; ReadOnly=True;"
　　　　.Open
　　End With

　　strSql = "select max(受入日) as 日付,品名,Lot,sum(数量) as 合計" _
　　　　　　　　& " from [資材受け入れシート$]" _
　　　　　　　　& " group by 品名,Lot order by max(受入日),品名,Lot"

　　Debug.Print strSql
　　rsXL.Open strSql, cnXL, adOpenForwardOnly

　　Worksheets("sheet2").Cells(2, 1).CopyFromRecordset rsXL
　　Worksheets("sheet2").Columns("A:A").NumberFormatLocal = "m/d"

　　rsXL.Close: Set rsXL = Nothing
　　cnXL.Close: Set cnXL = Nothing
　　MsgBox "Sheet2に出力しました"
End Sub

お礼

ありがとうございます。試してみましたが、完璧に実行できました。
参考どころか、こちらの希望どうりに動いてくれて感動しております。
これからこちらのプログラムを元にさらに改造していこうと思います。
本当にありがとうございました。

回答No.5

KenKen_SP

#2 ですが、コードの一部訂正を。
　　' // Dictionary キーはテキスト比較する
　　dic.CompareMode = TextCompare
　　　　　　　↓
　　' // Dictionary キーはテキスト比較する
　　dic.CompareMode = 1 ' TextCompare

お礼

詳しいご説明、ありがとうございました。マクロを実行させて頂きましたがちゃんと動きました。当方、初心者ですので大変勉強になりました。

回答No.3

Wendy02

こんばんは。

今、読んでいて、少しご説明が分かりにくいのですが、

>今回の在庫表作成のキーポイントは資材の「Lotと数量」を正確に管理することでした。
（加筆「...」）
「製品名のロットごとの数量の集計」ではないのでしょうか？

>品名（実際は漢字・カナなど）+Lotを1つのセルにくっつけて書き出して（方法がわかりません）、

D列に、仮の名前「Lot@」を挿入して、
*
= 品名　&","& Lot　で、Lot@ の下にコピーします。

　　A列　　B列　　C列　 D列　　E列
　受入日　品名　　Lot　Lot@　 数量
　　　　　　　　　　　　　*(数式）:D2

で、

[フィルターオプション]で、一覧表を出せばよいと思います。
（ただし、末尾に半角空白などが入っていることがありますから、置換などで、取り去ってから、数式で二つの文字をあわせてください）

後は、ほぼ手順は同じです。

Lot@
A,BNR32
A,DC200
B,SW200
B,AE860
B,BNR32
C,GD300
C,DC200

このように出てきますから、これで、[統合]を掛けて、

Lot@　　　数量
A,BNR32　　15
A,DC200　　3
B,SW200　　15
B,AE860　　4
B,BNR32　　1
C,GD300　　11
C,DC200　　7

と出てきたら、
　　　一列　[挿入]して
Lot@　V　　数量

データ－[区切り位置]　－コンマで、
A,BNR32　(右隣を一列あける)
A,DC200
B,SW200
B,AE860
B,BNR32
C,GD300
C,DC200

　　↓
A　　BNR32　　15
A　　DC200　　3
B　　SW200　　15
B　　AE860　　4
B　　BNR32　　1
C　　GD300　　11
C　　DC200　　7

とすれば、それぞれの品名とロットが別けられます。

そこで、前回の数式をそのまま利用して、
例えば、このように、J列にロット番号があるなら、

**
=SUMPRODUCT(MAX(($C$2:$C$12=J2)*($A$2:$A$12)))

　　H　　　　　I　　　　J　　　　K
受入日　　　品名　　Lot　　数量
**（数式）　　A　　BNR32　　15

とすればよいわけです。

お礼

簡潔かつご丁寧なご説明、ありがとうございます。
当方のイメージどおりに解説して頂いて本当に嬉しかったです。
マクロや関数に詳しくない当方にとって「助け舟」となりました。
本当にお世話になりました。

回答No.2

KenKen_SP

この手のものは仕様変更があった場合、ご自分でメンテできないと
大変ですよ。。

簡単な入力チェックは入れておきましたが、データの整合性、例えば

　・日付欄に文字列があるなど不適切なデータの存在
　・Lot で全角・半角が混在する

などのチェックも必要かもしれません。それが原因となって、集計値が
変わってしまう恐れがあるからです。

なるべくコメントを入れましたが、動作確認はろくにしてません^^;

あと考え方ですが、VBA は基本的に UNDO できません。したがって、
ソースデータを直接削除。。というのは乱暴で、新規シートなどに結果
出力し、ソースデータの削除はユーザーに任せた方が安全です。

Sub Sample()

　　Const SEPARATOR = "_$$_"

　　Dim dic　　　As Object
　　Dim Sh　　　 As Worksheet
　　Dim lLastRow As Long
　　Dim n　　　　As Long
　　Dim i　　　　As Long
　　Dim sKey　　 As String
　　Dim sItm　　 As String
　　Dim vTmp1　　As Variant
　　Dim vTmp2　　As Variant
　　Dim vKey　　 As Variant

　　' // データシート
　　Set Sh = Worksheets("資材受け入れシート")

　　' // エラー発生時にはラベル[Err_]の行に飛ばす
　　On Error GoTo Err_
　　' // Dictionary オブジェクトを用意
　　Set dic = CreateObject("Scripting.Dictionary")
　　' // Dictionary キーはテキスト比較する
　　dic.CompareMode = TextCompare

　　' // データの最終セル行番号を調べる（A列で判定）
　　lLastRow = Sh.Cells(Rows.Count, "A").End(xlUp).Row
　　' // 2行目から順に最終行まで集計していく
　　For i = 2 To lLastRow
　　　　' // A～D 列の4項目に入力漏れがあれば、エラーを発生させて中止
　　　　n = Application.CountA(Range(Sh.Cells(i, "A"), _
　　　　　　　　　　　　　　　　　　 Sh.Cells(i, "D")))
　　　　If n <> 4 Then
　　　　　　Application.Goto Reference:=Sh.Rows(i)
　　　　　　Err.Raise 1000, , CStr(i) & "行目にデータ入力漏れがあります"
　　　　End If
　　　　' // キーとなる文字列を生成
　　　　sKey = Trim$(Sh.Cells(i, "B").Value) & SEPARATOR & _
　　　　　　　 Trim$(Sh.Cells(i, "C").Value)
　　　　' // 集計値となる文字列を生成
　　　　' // 日付に時間があれば比較の障害となるのでカット
　　　　sItm = CStr(Int(Sh.Cells(i, "A").Value) & SEPARATOR & _
　　　　　　　　　　　　Sh.Cells(i, "D").Value)
　　　　' // Dictionary オブジェクトに登録済みか判定
　　　　If Not dic.Exists(sKey) Then
　　　　　　' // 登録がない＝初めての項目の場合
　　　　　　dic.Add Key:=sKey, Item:=sItm
　　　　Else
　　　　　　' // 登録がある＝既出項目の場合
　　　　　　' // キーを分解--＞品名、Lot の配列となる
　　　　　　vTmp1 = Split(dic(sKey), SEPARATOR)
　　　　　　' // 集計値を分解--＞日付、数量の配列となる
　　　　　　vTmp2 = Split(sItm, SEPARATOR)
　　　　　　' // 日付を比較し、直近の日付に更新
　　　　　　If CDate(vTmp1(0)) < CDate(vTmp2(0)) Then
　　　　　　　　vTmp1(0) = CStr(vTmp2(0))
　　　　　　End If
　　　　　　'// 値はそのまま加算する
　　　　　　vTmp1(1) = CStr(CDbl(vTmp1(1)) + CDbl(vTmp2(1)))
　　　　　　' // Dictionary オブジェクトの値を更新
　　　　　　dic(sKey) = vTmp1(0) & SEPARATOR & vTmp1(1)
　　　　　　' // 不要となった配列を消去する
　　　　　　Erase vTmp1
　　　　　　Erase vTmp2
　　　　End If
　　Next i

　　' // 出力処理
　　If dic.Count > 0 Then
　　　　Application.ScreenUpdating = False
　　　　Set Sh = Worksheets.Add(After:=Sheets(Sheets.Count))
　　　　i = 1
　　　　For Each vKey In dic.Keys
　　　　　　vTmp1 = Split(vKey, SEPARATOR)
　　　　　　vTmp2 = Split(dic(vKey), SEPARATOR)
　　　　　　Sh.Cells(i, "A").Value = vTmp2(0)
　　　　　　Sh.Cells(i, "B").Value = vTmp1(0)
　　　　　　Sh.Cells(i, "C").Value = vTmp1(1)
　　　　　　Sh.Cells(i, "D").Value = vTmp2(1)
　　　　　　i = i + 1
　　　　Next
　　　　Sh.Columns("A:D").AutoFit
　　　　Application.ScreenUpdating = True
　　　　MsgBox "Done.", vbInformation
　　End If

Bye_:
　　Set Sh = Nothing
　　Set dic = Nothing
　　Exit Sub
Err_:
　　MsgBox Err.Description, vbInformation
　　Resume Bye_
End Sub

回答No.1

Wendy02

こんばんは。

今、調べてみましたが、それは、マクロでなくても順序よくやれば、コマンドだけで出来ますね。
今回のマクロで解決するための問題点は、最後に書きました。

カーソルを何も書かれていないところ、
例： F1 に置く

メニュー－データ－フィルタオプションの設定
　リスト範囲　（Lot の列）
　指定した範囲　にチェック
　抽出範囲　F1 をクリック
　重複するレコードは無視　にチェック

カーソルを何も書かれていないところ、
　H1 に置く

メニュー－データ－統合

　集計の方法「合計」
　統合元範囲　（Lot と数量の範囲）->追加
　統合元範囲　（F1かに出力した列の範囲）->追加

　統合基準　左端列　にチェック

　OK をクリック

---------------------
H　　　　I
Lot　　数量
BNR32　　15
SW200　　14
AE860　　4
GD300　　11
DC200　　7
---------------------

後は数式だけです。

G列
品名
G2:～
=INDEX($B$1:$B$9,MATCH(H2,$C$1:$C$9,0),1)

(範囲は適宜変更してください）

F列
受注日
F2:～
=SUMPRODUCT(MAX(($C$2:$C$9=H2)*($A$2:$A$9)))

(範囲は適宜変更してください）
*数字になって出ますから、日付の書式に直してください。
約5500件以上に場合、Excelの下位バージョン(2000)などの場合は、うまく行かない恐れがあります。

完成図：
受注日　　品名　　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

マクロも基本的な設計方法は同じというか、よほどExcel自体を知らない人出ない限りは、記録マクロを利用するのが便利です。（プログラム的に、その方法－メソッドを越えないからです。）

マクロの場合のネックは、後戻りが利かないので、最初のデータの並びが正しくなっているか、などのチェック要素が必要なのと、受入日の最終日というのは、しょせん、この配列のワークシートの関数ほど簡単には出てこないのではないか、と思っています。

逆にいうと、この受入日の最終日の出力は、マクロではややこしいような気がします。それは、並びが昇順に並んでいないからです。

補足

早速のご回答、ありがとうございます。
なるほど、確かにWendy02様のやり方で整頓できますね。参考になりました。
ただ、私の「資材受け入れシート」の例が悪かったのですが、
　　A列　　B列　 C列　 D列
　受入日　品名　 Lot　 数量
　　7/7 　　A　 BNR32　 10
　　7/8 　　A　 BNR32　 5
　　7/9 　　A　 DC200　 3
　　7/10 　 B　 SW200　 2
　　7/7 　　B　 AE860　 4
　　7/8 　　B　 SW200　 12
　　7/5 　　B　 BNR32　 1
　　7/9 　　C　 GD300　 10
　　7/7 　　C　 GD300　 1
　　7/7 　　C　 DC200　 7
　　7/8 　　B　 SW200　 1
のような場合、つまり「Lot」が全く同じで別の商品があった場合、
正確に集計できない（品名-Lotが関連付けされない）のではないでしょうか？
もしそうであればデータ統合のところで、
品名（実際は漢字・カナなど）+Lotを1つのセルにくっつけて書き出して（方法がわかりません）、
　　ABNR32　 10
　　ABNR32　 5
　　ADC200　 3
　　BSW200　 2
の様にしてから集計すれば良いのでしょうか？
実際、品名は違いますがLotが同じ商品も沢山あります。
私事ですが、今回の在庫表作成のキーポイントは資材のLotと数量を正確に管理することでした。
他に簡単な方法がございましたら、具体的にお教え頂けませんか？
初心者で度々ご迷惑をお掛けしますが、宜しくお願いします。