- ベストアンサー
エクセルのデータの整理
教えて下さい 仕事で、その時々にデータを入力しているのですが 重複する項目データを合計したいのですがどうしても解りません 日付 得意先 工程 種別 数量 10/1 bbbb x03 A12 59 ** 10/1 ffff y03 A29 29 10/1 bbbb x03 B90 67 10/1 wwww z14 A12 45 10/1 bbbb x03 A12 26 ** 10/2 bbbb x03 A12 83 : : こんな具合にデータが続いていくのですが「**」印の行のみ 日付・得意先・工程・種別すべて共通しているのでその数量を合計して 重複したデータ表を整理したいのですが どのようにすれば良いのか解りません マクロかピボットを駆使すれば出来そうな気はするのですが 私の技量では到底かないません どなたか教えて頂けませんでしょうか
- みんなの回答 (9)
- 専門家の回答
質問者が選んだベストアンサー
こんにちは。 前回オア知らせしたマクロから下記のコードを削除して、マクロ名を Sub ○○○ と変更すれば普通のマクロの出来上がりです。 myRow = Target.Row If Target.Address = Range("$H$" & myRow).Address Then Application.EnableEvents = False Application.EnableEvents = True ご不明な点・不具合等がありましたらお知らせ下さい。
その他の回答 (8)
- kazuhiko5681
- ベストアンサー率49% (79/159)
こんにちは。早速コードの説明をさせていただきます。 エクセルは、イベントを持っています。今回は、ワークシートが持っているチェンジイベントを使いました。このイベントは、ワークシートのセルが変化した時点で走るイベントです。 Private Sub Worksheet_Change(ByVal Target As Range) 変数の宣言 Dim myRow As Integer Dim i As Integer Dim j As Integer Dim k As Integer Dim myCnt As Integer myRow = Target.Row 変化したセルの行を取得 If Target.Address = Range("$H$" & myRow).Address Then 変化したセルがH列の時のみ、以下の動作をさせる。 Application.EnableEvents = False チェンジイベントをストップさせる。 myRow = Cells(Rows.Count, 1).End(xlUp).Row データの最終行を取得 For i = 1 To myRow - 1 参照元の行番号を取得 If Cells(i, 1).Value <> "" Then 参照元のデータが入力済みの時のみ、以下の動作をさせる。 For j = i + 1 To myRow 参照先の行番号を取得 For k = 1 To 7 参照元(先)の列番号を取得 If Cells(i, k).Value = Cells(j, k).Value Then 参照元のデータと参照先のデータが一致した時、下記の動作をさせる。 myCnt = myCnt + 1 ここを通る度にmyCntの値を1ずつ増やす If myCnt = 7 Then myCntが7の時以下の動作をさせる。 Cells(i, 8).Value = Cells(j, 8).Value + Cells(i, 8).Value 参照先のH列の値と参照元のH列の値を足して参照元のH列に代入する。 Rows(j & ":" & j).ClearContents 参照先のデータをすべて消す。 End If End If Next k myCnt = 0 myCntの値を0にもどす。 Next j End If Next i あなた様の場合は、下記のコードは削除しても動作には影響がないと思われます。理由は、同じデータが最終行以外ないからです。つまり、データを入力した時点でもし上の行に同じデータがあった場合、入力した行のデータは消されてしまうからです。ただし、入力した行以外にも同じデータがあった場合は、下記のコードが必要となります。あなた様の場合は、下記のコードは削除して下さい。下記のコードの説明が必要な時はお知らせ下さい。 Do myRow = Cells(Rows.Count, 1).End(xlUp).Row If Cells(myRow, 1).End(xlUp).Row = 1 Then Exit Do For i = 2 To myRow If Cells(i, 1).Value = "" Then Rows(i & ":" & i).Delete Next i Loop Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select Application.EnableEvents = True End If End Sub >もし項目列が一つ或いは二つ増えた場合マクロのどの部分を修正すればよいのでしょうか 次の部分を修正して下さい。 For k = 1 To 7の7を最終列の列番号に変更する Cells(i, 8).Valueの8を最終列の列番号に変更する Cells(j, 8).Valueの8を最終列の列番号に変更する これでOKです。
お礼
早速の解説ありがとうございます >あなた様の場合は、下記のコードは削除しても動作には影響がないと思われ >ます。理由は、同じデータが最終行以外ないからです。 月別に保存している過去のデータもこれで整理出来そうですね 感謝します。 さすがに200行から300行もある表ですと、少し時間が掛かるようですが 手作業の事を考えると雲泥の差があります。 厚かましいお願いなんですが イベントプロシージャでなく普通のマクロに書き換えるにはどの部分を 変更すればよいのでしょうか? 過去のデータを整理していてダミーで最下行に上の行と同じ項目を入力して いるもので・・・・ 毎回、厚かましいお願いで申し訳ありません。
- imogasi
- ベストアンサー率27% (4737/17070)
少し短く簡潔に。少数例でテスト済み。 Sub test01() Worksheets("sheet1").Activate d = Range("a1").CurrentRegion.Rows.Count '最下行 Set ws2 = Worksheets("sheet2") n = 0 'sheet2最終 For i = 1 To d y = Year(Cells(i, 1)) m = Month(Cells(i, 1)) m = Mid("00", 1, 2 - Len(m)) & m d = Day(Cells(i, 1)) d = Mid("00", 1, 2 - Len(d)) & d h = y & m & d '日付キー作成 '----キー作成 k = h & Cells(i, 2) & Cells(i, 3) & Cells(i, 4) '-----Sheet2を探す。jはポインタ For j = 1 To n If ws2.Cells(j, 1) = k Then '既存に見つかり ws2.Cells(j, 6) = ws2.Cells(j, 6) + Cells(i, 5) GoTo p01 End If Next j n = n + 1 '新顔 ws2.Cells(n, 1) = k ws2.Cells(n, 6) = ws2.Cells(n, 6) + Cells(i, 5) ws2.Cells(n, 2) = Cells(i, 1): ws2.Cells(n, 3) = Cells(i, 2) ws2.Cells(n, 4) = Cells(i, 3): ws2.Cells(n, 5) = Cells(i, 4) p01: Next i End Sub
お礼
御礼が遅れて申し訳ありません このマクロをコピー・ペーストして実行したのですが 「型が一致しません」と叱られました。 何が原因なのかわかりませんが、色々と試してみて勉強してみます ありがとうございました
- kazuhiko5681
- ベストアンサー率49% (79/159)
こんばんわ。マクロに記述ミスがあったようなので、修正マクロを作ってみました。申し訳ございませんでした。次のように操作してみて下さい。 1.新規ブックを開き、ALT+F11キーを押してVBE画面を開く 2.画面左上のVBAProject徒書いてある下のSheet1をダブルクリックし、右側の白い部分へ下のコードをコピー・ペーストする。 3.ALT+F11キーを押してエクセルの画面にもどり、次のように操作する。 (1)シート1のA1~H1に適当な値を入力する (2)シート1のA2~H2に(1)とそっくり同じように入力する。 H1とH2の合計値がH1に表示され、2行目に入力されたデータが消える。 (3)シート1のA2からH2に(1)とは違う値を入力する。 今度は入力されたデータが残り、A3にカーソルが飛ぶ。 このように動作するはずです。 Private Sub Worksheet_Change(ByVal Target As Range) Dim myRow As Integer Dim i As Integer Dim j As Integer Dim k As Integer Dim myCnt As Integer myRow = Target.Row If Target.Address = Range("$H$" & myRow).Address Then Application.EnableEvents = False myRow = Cells(Rows.Count, 1).End(xlUp).Row For i = 1 To myRow - 1 If Cells(i, 1).Value <> "" Then For j = i + 1 To myRow For k = 1 To 7 If Cells(i, k).Value = Cells(j, k).Value Then myCnt = myCnt + 1 If myCnt = 7 Then Cells(i, 8).Value = Cells(j, 8).Value + Cells(i, 8).Value Rows(j & ":" & j).ClearContents End If End If Next k myCnt = 0 Next j End If Next i Do myRow = Cells(Rows.Count, 1).End(xlUp).Row If Cells(myRow, 1).End(xlUp).Row = 1 Then Exit Do For i = 2 To myRow If Cells(i, 1).Value = "" Then Rows(i & ":" & i).Delete Next i Loop Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select Application.EnableEvents = True End If End Sub うまく動作することが確認できたら、データが入力されているブックのコードエディターにコードをコピー・ペーストします。この時、気をつけていただきたいのは、VBAProjectの下に、ブックに挿入されているシートの枚数分(例えばシートが3枚あったとしたらShet1・Sheet2・Sheet3)コードエディタがあります。Sheet2・Sheet3もそれぞれダブルクリックしてそれぞれのコードエディタに同じようにコードを貼り付けて実行して下さい。 また、ご不明な点・不都合な点がございましたらご遠慮なくお知らせ下さい。
お礼
ありがとうございます。 上記コードをコピー・ペーストしましたら私のイメージ通りに整理できました 重複行が合計される様は感動しました。ありがとうございます。 厚かましいお願いなんですが、もし項目列が一つ或いは二つ増えた場合 マクロのどの部分を修正すればよいのでしょうか それと、このコードを勉強したいのでコメントがあれば嬉しいです。 宜しくお願いいたします。
- kazuhiko5681
- ベストアンサー率49% (79/159)
はじめまして。サンプルマクロを作ってみました。下記の様に操作すれば、あなた様は何もせずに自動であなた様のおやりになりたいことが実現できます。 1.新規ブックを開き、ALT+F11キーを押してVBE画面を開く 2.画面左上のVBAProject徒書いてある下のSheet1をダブルクリックし、右側の白い部分へ下のコードをコピー・ペーストする。 3.ALT+F11キーを押してエクセルの画面にもどり、シート1のA列~E列に適当な値を入力する あなた様のおやりになりたいことが実現できているはずです。 Private Sub Worksheet_Change(ByVal Target As Range) Dim myRow As Integer Dim i As Integer Dim j As Integer Dim myCnt As Integer myRow = Target.Row If Target.Address = Range("$E$" & myRow).Address Then For i = 2 To Cells(Rows.Count, 2).End(xlUp).Row - 1 myCnt = 0 For j = 1 To 4 If Cells(i, j).Value = Cells(myRow, j) Then myCnt = myCnt + 1 Next j If myCnt = 4 Then myRow = i If myCnt = 4 Then Application.EnableEvents = False Cells(myRow, 5).Value = Cells(myRow, 5).Value + Target.Value Target.EntireRow.Delete Shift:=xlShiftUp Application.EnableEvents = True End If Next i Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select End If End Sub もし、不都合な点がありましたら、ご遠慮なくお知らせ下さい。あなた様のおやりになりたいことが実現できるまで、私でよろしければご一緒に考えていきたいと思います。
お礼
御礼が遅れて申し訳ありません 丁寧なマクロをありがとうございます。 質問なんですが、このマクロはあのイベントマクロと言うものなんでしょうか? 私は、マクロの初心者で今ひとつイベントマクロを理解しておらず 「kazuhiko5681」様の仰る通りに上記のマクロをコピー&ペーストしたのですが なんともなりませんでした。 恐れ入りますが、今一度このマクロの操作方法を教えて頂けませんでしょうか
- nishi6
- ベストアンサー率67% (869/1280)
質問の表がSheet1にあり、重複データを合計してSheet2に書き出しています。 Sheet1は1行目が表題で、データはA2から入力されているとしています。 Sheet1のコードウインドウに貼り付けます。 (変数を使ったり、データを取り込んだりと少し長くなってしまいました。ご容赦を) ↓ Sub JyufukuTotal() Dim TBL As Range 'データ範囲 Dim r1 As Long, r2 As Long, pr1 As Long, rowCot As Long '行カウンタ Dim col As Integer, colCot As Integer '列カウンタ Dim dt() As Variant 'データ格納配列 '***シートのデータを配列に取り込む*** Range("A1").Select Set TBL = ActiveCell.CurrentRegion TBL.Offset(1, 0).Resize(TBL.Rows.Count - 1, TBL.Columns.Count).Select rowCot = Selection.Rows.Count colCot = Selection.Columns.Count ReDim dt(rowCot, colCot) Dim Total As Double '合計値 dt = Selection '***重複行の合計*** Worksheets("Sheet2").Cells.ClearContents Range("A1:E1").Copy Destination:=Worksheets("Sheet2").Range("A1:E1") Dim Jyufuku As Boolean '重複があったか pr1 = 1 For r1 = 1 To rowCot - 1 If dt(r1, 1) <> "" Then Total = dt(r1, 5): Jyufuku = False For r2 = r1 + 1 To rowCot If dt(r1, 1) = dt(r2, 1) And dt(r1, 2) = dt(r2, 2) And _ dt(r1, 3) = dt(r2, 3) And dt(r1, 4) = dt(r2, 4) Then Total = Total + dt(r2, 5) Jyufuku = True: dt(r2, 1) = "" '重複して集計しないように日付を消去 End If Next End If '重複行の書き出し(Sheet2) If Jyufuku Then pr1 = pr1 + 1 With Worksheets("Sheet2") .Cells(pr1, 1) = dt(r1, 1) .Cells(pr1, 2) = dt(r1, 2) .Cells(pr1, 3) = dt(r1, 3) .Cells(pr1, 4) = dt(r1, 4) .Cells(pr1, 5) = Total: Jyufuku = False End With End If Next: Range("A1").Select End Sub
お礼
返信が遅れて申し訳ありませんでした 早速のマクロありがとう御座います。 エクセルにコピー&ペーストして実行してみたのですが 「型が一致しません」と叱られました 恐らく変数の辺りだと思うのですが私には全くわかりません 出来れば原因を教えて頂けませんでしょうか 項目行は日付・曜日・EOS・店名・品種・工程1・工程2・数量 と 8項目あります。
- imogasi
- ベストアンサー率27% (4737/17070)
(1)操作・フィルタを使う。(#1のご回答) (2)関数A.DSUMを使う。 B.SUMIFを使う。 C.SUMPRODUCTを使う。 D.配列数式を使う。 (3)VBAを使う。 ここでは(2)A.を載せます。下記例で理解してください。例データとしてA1:B6に コード 計数 a 1 a 2 b 3 a 4 c 5 D1:D2に コード a といれて、どこでも良いが仮にB9に =DSUM(A1:B6,"計数",D1:D2)と式を入れる。 7が答えです。コード列のaのものを足したのです。 計数は"計数"のように""で囲ってください。 2.Bは =SUMIF(A2:A6,"a",B2:B6)です。(#2のご回答)
お礼
お返事遅れて申し訳ありませんでした。 本当にご丁寧な回答感謝いたします。 データを抽出するのに皆様の回答(考え方)が役にたちそうです 今回はデータ表を整理(重複行を削除) したい為 マクロがベストかなって思っています。 でも、 =DSUM や =SUMIF は参考になりました。 ありがとうございました
- cafedemocha
- ベストアンサー率29% (232/789)
関数ウィザードを起動して、SUMIF関数を使用しては如何ですか? 集計条件を様々に変える事も出来ますよ
お礼
お返事遅れて申し訳ありませんでした。 >関数ウィザードを起動して、SUMIF関数を使用しては如何ですか? はい関数を使うのも考えたのですが、データ表を整理(重複行を削除) したいんです そうなるとやっぱりマクロかなって思っているのですが・・・ 回答ありがとうございます。
- 0shiete
- ベストアンサー率30% (148/492)
手作業になりますが、[データ]->[フィルタ]をつかって 「**」の行のみ表示させて、合計するというのはどうですか?
お礼
お返事遅れて申し訳ありませんでした >手作業になりますが、[データ]->[フィルタ]をつかって これも考えたのですが何とかマクロでっと思っていたものですから 自動で処理したいのです。 ありがとうございます。
お礼
お忙しい中、あきれるような質問に答えていただき恐縮しています。 「kazuhiko5681」様には感謝、感謝です。 これで仕事の効率も随分よくなりました PS:動作テストしてみたところ、”End Sub”直前の ”End If"でエラーが でましたので、削除しましたら正常に動いてくれました。 マクロは未熟者ですので、これからもどうぞ宜しくお願いいたします。 ありがとう御座いました。