エクセルのデータの整理

質問

教えて下さい
仕事で、その時々にデータを入力しているのですが
重複する項目データを合計したいのですがどうしても解りません

日付　　得意先　　工程　　種別　　数量
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
　　　　　　　　　：
　　　　　　　　　：

こんな具合にデータが続いていくのですが「**」印の行のみ
日付・得意先・工程・種別すべて共通しているのでその数量を合計して
重複したデータ表を整理したいのですが

どのようにすれば良いのか解りません
マクロかピボットを駆使すれば出来そうな気はするのですが
私の技量では到底かないません
どなたか教えて頂けませんでしょうか

回答No.9

kazuhiko5681 · ベストアンサー

こんにちは。
前回オア知らせしたマクロから下記のコードを削除して、マクロ名を
Sub ○○○
と変更すれば普通のマクロの出来上がりです。

myRow = Target.Row
If Target.Address = Range("$H$" & myRow).Address Then
Application.EnableEvents = False
Application.EnableEvents = True

ご不明な点・不具合等がありましたらお知らせ下さい。

お礼

お忙しい中、あきれるような質問に答えていただき恐縮しています。

「kazuhiko5681」様には感謝、感謝です。
これで仕事の効率も随分よくなりました

PS:動作テストしてみたところ、”End Sub”直前の　”End If"でエラーが
　　でましたので、削除しましたら正常に動いてくれました。

マクロは未熟者ですので、これからもどうぞ宜しくお願いいたします。
ありがとう御座いました。

回答No.8

kazuhiko5681

こんにちは。早速コードの説明をさせていただきます。
エクセルは、イベントを持っています。今回は、ワークシートが持っているチェンジイベントを使いました。このイベントは、ワークシートのセルが変化した時点で走るイベントです。

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　ここを通る度にmyCntの値を１ずつ増やす
If myCnt = 7 Then
myCntが７の時以下の動作をさせる。
Cells(i, 8).Value = Cells(j, 8).Value + Cells(i, 8).Value
参照先のＨ列の値と参照元のＨ列の値を足して参照元のＨ列に代入する。
Rows(j & ":" & j).ClearContents
参照先のデータをすべて消す。
End If
End If
Next k
myCnt = 0　myCntの値を０にもどす。
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を最終列の列番号に変更する
これでＯＫです。

お礼

早速の解説ありがとうございます

＞あなた様の場合は、下記のコードは削除しても動作には影響がないと思われ
＞ます。理由は、同じデータが最終行以外ないからです。

月別に保存している過去のデータもこれで整理出来そうですね
感謝します。
さすがに２００行から３００行もある表ですと、少し時間が掛かるようですが
手作業の事を考えると雲泥の差があります。

厚かましいお願いなんですが
イベントプロシージャでなく普通のマクロに書き換えるにはどの部分を
変更すればよいのでしょうか？
過去のデータを整理していてダミーで最下行に上の行と同じ項目を入力して
いるもので・・・・

毎回、厚かましいお願いで申し訳ありません。

回答No.7

imogasi

少し短く簡潔に。少数例でテスト済み。
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

お礼

御礼が遅れて申し訳ありません
このマクロをコピー・ペーストして実行したのですが
「型が一致しません」と叱られました。

何が原因なのかわかりませんが、色々と試してみて勉強してみます
ありがとうございました

回答No.6

kazuhiko5681

こんばんわ。マクロに記述ミスがあったようなので、修正マクロを作ってみました。申し訳ございませんでした。次のように操作してみて下さい。

１.新規ブックを開き、ＡＬＴ＋Ｆ１１キーを押してＶＢＥ画面を開く
２.画面左上のVBAProject徒書いてある下のSheet1をダブルクリックし、右側の白い部分へ下のコードをコピー・ペーストする。
３.ＡＬＴ＋Ｆ１１キーを押してエクセルの画面にもどり、次のように操作する。
　(1)シート１のＡ１～Ｈ１に適当な値を入力する
　(2)シート１のＡ２～Ｈ２に(1)とそっくり同じように入力する。
　　Ｈ１とＨ２の合計値がＨ１に表示され、２行目に入力されたデータが消える。
　(3)シート１のＡ２からＨ２に(1)とは違う値を入力する。
　　今度は入力されたデータが残り、Ａ３にカーソルが飛ぶ。
このように動作するはずです。

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の下に、ブックに挿入されているシートの枚数分(例えばシートが３枚あったとしたらShet1・Sheet2・Sheet3)コードエディタがあります。Sheet2・Sheet3もそれぞれダブルクリックしてそれぞれのコードエディタに同じようにコードを貼り付けて実行して下さい。

また、ご不明な点・不都合な点がございましたらご遠慮なくお知らせ下さい。

お礼

ありがとうございます。
上記コードをコピー・ペーストしましたら私のイメージ通りに整理できました

重複行が合計される様は感動しました。ありがとうございます。

厚かましいお願いなんですが、もし項目列が一つ或いは二つ増えた場合
マクロのどの部分を修正すればよいのでしょうか

それと、このコードを勉強したいのでコメントがあれば嬉しいです。

宜しくお願いいたします。

回答No.5

kazuhiko5681

はじめまして。サンプルマクロを作ってみました。下記の様に操作すれば、あなた様は何もせずに自動であなた様のおやりになりたいことが実現できます。

１.新規ブックを開き、ＡＬＴ＋Ｆ１１キーを押してＶＢＥ画面を開く
２.画面左上のVBAProject徒書いてある下のSheet1をダブルクリックし、右側の白い部分へ下のコードをコピー・ペーストする。
３.ＡＬＴ＋Ｆ１１キーを押してエクセルの画面にもどり、シート１のＡ列～Ｅ列に適当な値を入力する
あなた様のおやりになりたいことが実現できているはずです。

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」様の仰る通りに上記のマクロをコピー＆ペーストしたのですが
なんともなりませんでした。

恐れ入りますが、今一度このマクロの操作方法を教えて頂けませんでしょうか

回答No.4

nishi6

質問の表が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・数量　と
８項目あります。

回答No.3

imogasi

（１）操作・フィルタを使う。（＃１のご回答）
（２）関数Ａ．ＤＳＵＭを使う。
　　　　　Ｂ．ＳＵＭＩＦを使う。
　　　　　Ｃ．ＳＵＭＰＲＯＤＵＣＴを使う。
　　　　　Ｄ．配列数式を使う。　
（３）ＶＢＡを使う。
ここでは（２）Ａ．を載せます。下記例で理解してください。例データとしてＡ１：Ｂ６に
コード 計数
a 1
a 2
b 3
a 4
c 5
Ｄ１：Ｄ２に
コード
a
といれて、どこでも良いが仮にＢ９に
=DSUM(A1:B6,"計数",D1:D2)と式を入れる。
７が答えです。コード列のaのものを足したのです。
計数は"計数"のように""で囲ってください。
２．Ｂは
=SUMIF(A2:A6,"a",B2:B6)です。（＃２のご回答）

お礼

お返事遅れて申し訳ありませんでした。

本当にご丁寧な回答感謝いたします。

データを抽出するのに皆様の回答（考え方）が役にたちそうです
今回はデータ表を整理（重複行を削除） したい為
マクロがベストかなって思っています。

でも、 =DSUM　や　=SUMIF　は参考になりました。
ありがとうございました

回答No.2

cafedemocha

関数ウィザードを起動して、SUMIF関数を使用しては如何ですか？
集計条件を様々に変える事も出来ますよ

お礼

お返事遅れて申し訳ありませんでした。

＞関数ウィザードを起動して、SUMIF関数を使用しては如何ですか？

はい関数を使うのも考えたのですが、データ表を整理（重複行を削除）
したいんです
そうなるとやっぱりマクロかなって思っているのですが・・・

回答ありがとうございます。

回答No.1

0shiete

手作業になりますが、[データ]->[フィルタ]をつかって
「**」の行のみ表示させて、合計するというのはどうですか？

お礼

お返事遅れて申し訳ありませんでした

＞手作業になりますが、[データ]->[フィルタ]をつかって

これも考えたのですが何とかマクロでっと思っていたものですから
自動で処理したいのです。

ありがとうございます。