【Excelマクロ】重複をチェックして表を整頓する方法
- Excelマクロを使用して、資材の在庫表を整理する方法を教えてください。
- 在庫表で品名に重複がある場合、同じ物を表すLotを確認し、行を削除して数量を加算する方法を知りたいです。
- 特に2列目の品名の重複を確認するだけでなく、3列目のLotの重複も確認する必要があります。また、削除後の行に削除した数量を加算する方法もお教えください。
- ベストアンサー
【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 「受入日」の所はできれば最終日になれば良いかなと思っています。 会社で期限を決められているのですが、手こずってしまい前へ進みません。説明が分かりづらいかもしれませんが、どうか宜しくお願いいたします。
- MC28SP
- お礼率26% (4/15)
- Visual Basic
- 回答数4
- ありがとう数1
- みんなの回答 (4)
- 専門家の回答
質問者が選んだベストアンサー
どうも「ソート」という表現はふさわしくないようです。「サマリ」に訂正します。 ついでに、受入日の最終日の取得を追加しました。 '---------------------------- '重複データのサマリ '---------------------------- 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" '書式を設定 最後に、このプログラムは1度実行すると、2度目はそのままでは ただしく動作しません。 2度目以降は、6列目から11列目までをクリアしてください。 これは初期化の問題ですが、そこは省略させていただきました。
その他の回答 (3)
- Tetralemma
- ベストアンサー率54% (57/104)
先ほどの1は、よく観たら間違ってますね。 大変失礼しました。以下に正しいソースを再掲載します。 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 最後の値を返すところが抜けてました。
- Tetralemma
- ベストアンサー率54% (57/104)
1.まずは、対象データの範囲を調べる機能、 2.次にソート機能が必要です。 3.それから、上から下へ重複を調べる機能、 4.重複したデータを、加算する機能、 5.加算した結果を、書き出す機能が必要ですね。 質問される場合は、このように、機能を分割して、その内、 1つか2つを質問された方が、回答していただけると思います。 とはいえ、お困りのようなので、ポイントだけ解説しましょう。 '----------------------------------------- '1.対象データの範囲を調べる '----------------------------------------- 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 '----------------------------------------- '2.ソート '----------------------------------------- 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 '--------------------------------------- これでソートも合計も出来ました。 とりあえずここまで出来ればあとはなんとかなると思いますが?
- sakusaker7
- ベストアンサー率62% (800/1280)
お困りなのはわかりました。 で、どういった回答をお望みなのでしょうか? 考え方としてはあっていると思いますのでそのままプログラムとして書き出せばよいのではないでしょうか? より具体的な部分でどう書いてよいかわからないというのであれば、その旨補足していただければ アドバイスできるかもしれません。 プログラム(マクロ)を代わりに書いてくれという依頼であれば残念ながら ご期待には添えません。 > ご教授願います。 こういう場合は「教示」を使います。
関連するQ&A
- 【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 「受入日」の所はできれば最終日になれば良いかなと思っています。 会社で期限を決められているのですが、手こずってしまい前へ進みません。説明が分かりづらいかもしれませんが、どうか宜しくお願い致します。
- ベストアンサー
- オフィス系ソフト
- 【excelマクロVBA】表の集計・転記マクロの改造点について
以前、こちらのカテゴリーで重複をチェックしてその行を削除し表を整頓するマクロとしてプログラムを教えて頂きました。 (資材受け入れシート) → (Sheet2) 受入日 品名 Lot 数量 受入日 品名 Lot 数量 7/7 A BNR32 10 7/8 A BNR32 15 7/8 A BNR32 5 7/10 B SW200 14 7/10 B SW200 2 → 7/7 B AE860 4 7/7 B AE860 4 7/9 C GD300 11 7/8 B SW200 12 7/7 C DC200 7 7/9 C GD300 10 7/7 C GD300 1 7/7 C DC200 7 プログラムの内容は、 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 と記述されており、正常に動作いたしました。 ところが、会社から受入日,品名,Lot,数量だけでなく、納入業者,賞味期限,担当者の項目(列)を追加し転記できるように欲しいと命じられました。業務の都合上、列の順番は受入日,<納入業者>,品名,Lot,<賞味期限>,数量,<担当者>の順番で挿入し、追加した3項目については計算させる必要は無く、転記だけさせたいと考えています。上のプログラムを元に改造を試みたのですが、転記が上手くできません。どこの部分にどのように記述・変更したら良いのかが分りません。どなたかご存知の方、お教え願えませんでしょうか?表の作成までにもう少しというところで躓いてしまい頭を悩ませております。初歩的な質問かもしれませんが、宜しくお願い致します。
- 締切済み
- オフィス系ソフト
- エクセル VBA SQL 開始行の指定
namatyu MC285Pさんの質問からの解答を利用させていただいて、会社の履歴表を作成しましたが、訳あって、(資材受け入れシート)側の開始行をA1からA2に変えた所、「パラメータがすくなすぎます。14を指定してください」と出てしまいます。 Sheets("資材受け入れシート").Range("A1:D1").Copyを Sheets("資材受け入れシート").Range("A2:D2").Copyに変えても解決しません… SQL文が勉強不足で、変更場所が分かりません 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 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 色々、試したのですが、分かりません… すいませんが、どたたか教えてください、お願いします。
- ベストアンサー
- オフィス系ソフト
- Excel2010で行ごとの重複削除
Excel2010です。 A行目 1 3 5 5 2 2 3 B行目 2 3 5 5 4 4 C行目 1 9 7 9 9 ↓ A行目 1 3 5 2 B行目 2 3 4 5 C行目 1 7 9 というように、行ごとに重複の削除をしたいと思っています。 データタブに重複の削除があるのですが、列ごとにやるようなので、一度シート全体を 行と列を入れ替えて別シートにコピーして、 1列目全体を選択して、1列目で重複の削除を実行 2列目全体を選択して、2列目で重複の削除を実行 ・・・ というやり方もあるのですが、今扱っているエクセルは197行197列あります。 列選択、重複の削除アイコンをクリックするのを197回繰り返すのは大変です。 自動化する方法はないものでしょうか?
- ベストアンサー
- その他MS Office製品
- Excel2003での行重複削除
Excel2003で、列のセル内容が同一の場合を削除・抽出することは可能でしょうか。例えば、次のようなイメージです。 行番号 A列 B列 行1 A1県 B1市 行2 A1県 B2市 行3 A1県 B3市 行4 A1県 B4市 行5 A2県 B5市 行6 A2県 B6市 ここから、A列が同一の行の重複を削除したいのです。上記では、行1から行4までは「A1県」で同一なので、1つの行だけ残し後の行は削除したい。B列の内容は重複削除で一部消えますが構いません。上記の場合、抽出結果は次のようになります(先頭行だけ残した場合ですが)。 行番号 A列 B列 行1 A1県 B1市 行5 A2県 B5市 データベースが大きいため、手作業で削除して行くのは大変です。適当な方法がありましたら、是非、ご教示ください。 どうぞ宜しくお願いします。
- ベストアンサー
- オフィス系ソフト
- 重複行を削除
重複する行をVBAコードで削除したいのですが A列 B列 C列 あ 1 a あ 1 a あ 2 a い 1 a い 2 c い 2 c A列 B列 C列 あ 1 a あ 2 a い 1 a い 2 c のようにABC列同一文字は1行にしたいのですがVBAコード、関数の解る方ご教授願います。
- 締切済み
- Visual Basic
- 【Excel VBA】重複行の削除
はじめまして。 IDの重複を削除し、日付データを横1列にまとめるVBAについてご教示いただけますと幸いです。 ------------------------------------------------------- ▼シート1(データ入力がされているシート) A B C D E F 1 ID 日付 2 1234 1/1 1/6 1/10 1/20 3 1234 2/3 2/20 4 1234 3/2 5 7777 1/10 1/15 1/20 6 7777 2/2 2/12 2/22 7 9876 2/3 ⇓ マクロ起動後 ▼シート2(重複行を削除しまとめたシート) A B C D E F G H 1 ID 日付 2 1234 1/1 1/6 1/10 1/20 2/3 2/20 3/2 3 7777 1/10 1/15 1/20 2/2 2/12 2/22 4 9876 2/3 【補足】 列情報 ・A列…ID ・B-F列…日付(左詰め) ※日付はIDごと月毎に行が変わるため、IDによって複数行存在する場合があります。 ※A列のIDは重複しない場合もあれば、4行以上ある場合があります。 ※シート1のデータはおおよそ1000-5000行です。 ※IDに対して、日付は5つあれば問題ありません。そのためG列以降の日付を削除しても支障はございません。 ------------------------------------------------------ VBAの知識があまりなく、調べて出てきたものをコピペ使用も試みたのですが、 上手く動かす事ができませんでした…。 お力添え頂けますと幸いです…。 Windows10でエクセル2016を使用しております。 何卒宜しくお願いいたします。
- ベストアンサー
- Excel(エクセル)
- 【Excel VBA】条件つき行削除
Excel2003を使用しています。 システムからCSVで落としたデータで、データの並び方に規則性があるので、それを利用して、不要部分のデータをマクロで削除できないかと思い、質問させていただきます。 A列に『累計』を含む文字があった場合、その行のD列が0だったら、その行より上の行のA列に『計上日』と入力されている行までを削除するということをしたいです。 下記でいうと、2~5行までを削除したいです。 A B C D 1 2 計上日 3 4 5 累計 0 6 7 計上日 8 9 累計 1000 上記では、B列、C列には何も書いていませんが、実際はデータが入力されていたり、空欄だったりです。 D列が0の行を削除するコードはわかるのですが、さらに、条件が加わっても同じように処理は可能でしょうか? よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- 行削除のマクロ
B列~F列にデータが入っていてB列の最終行の下セルを選択しクリップボードのデータを貼り付けた後、貼り付けたデータの最初の3行を削除するマクロを作っています。 Sub Macro1() ''Worksheets("Sheet1").Activate ' addrw = Range("b65536").End(xlUp).Offset(1).Row Cells(addrw, 2).PasteSpecial end sub これでB列の最終行の下にデータを貼り付けることまで出来たのですが貼り付けた最初の3行の削除の仕方がわかりません。 いい方法があれば教えていただけないでしょうか。 例えばB列の10行目まで既に入力されていた場合、11行目からクリップボードのデータを貼り付け(ここまでは上のプログラムで出来ました。)、11行目から13行目を削除したいのですがどうしたらいいでしょうか?
- ベストアンサー
- オフィス系ソフト
- 重複行を完全削除するエクセルのマクロ
Sub sakujyo() Dim i, ii As Long For i = 1 To Range("a65336").End(xlUp).Row For ii = Range("a65336").End(xlUp).Row To i + 1 Step -1 If Cells(i, 2).Value = Cells(ii, 2).Value _ And Cells(i, 4).Value = Cells(ii, 4).Value _ And Cells(i, 5).Value = Cells(ii, 5).Value Then Dim iii As Byte iii = 1 Rows(ii).Delete Shift:=xlUp End If Next ii If iii = 1 Then Rows(i).Delete Shift:=xlUp iii = 0 Next i End Sub データーが下の表のように入っております。 A B C E F 1 1/26 a1234 fdsa 5000 C1 2 1/27 a4567 sdfa 4000 T2 3 1/28 a1234 dfsa 5000 C1 4 1/30 b4567 asdf 6600 A2 5 2/10 b4567 fsda 6600 A2 6 2/10 a1234 afds 5000 C1 B列、E列、F列が完全一致(重複1行目と3行目と6行目・4行目と5行目)で削除し結果的に2行目だけ残る方法がしたいのですが、このマクロですと少ないデータですとうまく動くのですが、『大量のデータを一気に削除出来ない』、『同じ重複が3つ以上のデータが多数ある場合データが削除されずに残ってしまう』エラーが出てしまいます。どうかお教えください。
- ベストアンサー
- オフィス系ソフト
お礼
Tetralemma様、数回に亘って詳しいご説明ありがとうございました。 当方、マクロ初心者ですので印刷して解析しながら勉強しているところです。大変参考になりました。本当にありがとうございました。