![](http://oshiete.xgoo.jp/images/v2/pc/qa/question_title.png?8acaa2e)
教えて下さい
仕事で、その時々にデータを入力しているのですが
重複する項目データを合計したいのですがどうしても解りません
日付 得意先 工程 種別 数量
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ベストアンサー
- 回答日時:
こんにちは。
前回オア知らせしたマクロから下記のコードを削除して、マクロ名を
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
- 回答日時:
こんにちは。
早速コードの説明をさせていただきます。エクセルは、イベントを持っています。今回は、ワークシートが持っているチェンジイベントを使いました。このイベントは、ワークシートのセルが変化した時点で走るイベントです。
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行もある表ですと、少し時間が掛かるようですが
手作業の事を考えると雲泥の差があります。
厚かましいお願いなんですが
イベントプロシージャでなく普通のマクロに書き換えるにはどの部分を
変更すればよいのでしょうか?
過去のデータを整理していてダミーで最下行に上の行と同じ項目を入力して
いるもので・・・・
毎回、厚かましいお願いで申し訳ありません。
No.7
- 回答日時:
少し短く簡潔に。
少数例でテスト済み。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
- 回答日時:
こんばんわ。
マクロに記述ミスがあったようなので、修正マクロを作ってみました。申し訳ございませんでした。次のように操作してみて下さい。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もそれぞれダブルクリックしてそれぞれのコードエディタに同じようにコードを貼り付けて実行して下さい。
また、ご不明な点・不都合な点がございましたらご遠慮なくお知らせ下さい。
ありがとうございます。
上記コードをコピー・ペーストしましたら私のイメージ通りに整理できました
重複行が合計される様は感動しました。ありがとうございます。
厚かましいお願いなんですが、もし項目列が一つ或いは二つ増えた場合
マクロのどの部分を修正すればよいのでしょうか
それと、このコードを勉強したいのでコメントがあれば嬉しいです。
宜しくお願いいたします。
No.5
- 回答日時:
はじめまして。
サンプルマクロを作ってみました。下記の様に操作すれば、あなた様は何もせずに自動であなた様のおやりになりたいことが実現できます。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」様の仰る通りに上記のマクロをコピー&ペーストしたのですが
なんともなりませんでした。
恐れ入りますが、今一度このマクロの操作方法を教えて頂けませんでしょうか
No.4
- 回答日時:
質問の表が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項目あります。
No.3
- 回答日時:
(1)操作・フィルタを使う。
(#1のご回答)(2)関数A.DSUMを使う。
B.SUMIFを使う。
C.SUMPRODUCTを使う。
D.配列数式を使う。
(3)VBAを使う。
ここでは(2)A.を載せます。下記例で理解してください。例データとしてA1:B6に
コード計数
a1
a2
b3
a4
c5
D1:D2に
コード
a
といれて、どこでも良いが仮にB9に
=DSUM(A1:B6,"計数",D1:D2)と式を入れる。
7が答えです。コード列のaのものを足したのです。
計数は"計数"のように""で囲ってください。
2.Bは
=SUMIF(A2:A6,"a",B2:B6)です。(#2のご回答)
お返事遅れて申し訳ありませんでした。
本当にご丁寧な回答感謝いたします。
データを抽出するのに皆様の回答(考え方)が役にたちそうです
今回はデータ表を整理(重複行を削除) したい為
マクロがベストかなって思っています。
でも、 =DSUM や =SUMIF は参考になりました。
ありがとうございました
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Excel(エクセル) VBAで重複データを合算したい(時間) 1 2022/12/08 23:06
- Visual Basic(VBA) ExcelVBAの複数指定範囲の構文 2 2022/05/26 22:39
- Excel(エクセル) 【マクロ】同じフォルダ内にある複数ブックから1つのブック内の1シートにデータを集めたい 6 2022/09/28 18:16
- その他(IT・Webサービス) 高速処理可能な表計算ソフトについて ExcelやGoogleスプレッドシートのような表計算ソフトで、 2 2023/04/29 16:06
- 統計学 混合効果モデルについて 3 2022/05/31 21:00
- Wi-Fi・無線LAN ポケットWi-Fiに同時に複数端末を接続し、Zoom会議をした場合のデータ通信量 2 2022/05/13 14:34
- 宇宙科学・天文学・天気 AIが答えた方程式 1 2023/02/20 00:12
- Visual Basic(VBA) 列と行の名前(重複あり)が交差するセルに、データを入力したい 3 2022/06/12 11:17
- 統計学 どの統計を使えばいいのか教えてください(EZ-Rを使用) 5 2022/10/11 13:28
- その他(Microsoft Office) ピボットテーブルへの集計フィールド挿入 1 2023/02/26 11:33
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
エクセルで日付から日にちを削...
-
Excelで2つのデータの突合せを...
-
エクセルで1列に500行並んだデ...
-
Excelで2行単位のソートの出来...
-
excel:別シートの値を飛び飛び...
-
複数の条件に合う行番号を取得...
-
Excelの30個ずつの平均値の出し方
-
エクセルで、重複データを除外...
-
Countifよりも早く重複数をカウ...
-
エクセル2016にて、行挿入&コピ...
-
エクセルで横並びの複数データ...
-
VBA 数式を最終行までコピー
-
エクセルで時刻だけを抜き出す...
-
エクセルのデータの整理
-
エクセルの切り取り、挿入に関して
-
Excel 列データのランダムな並...
-
Excel エクセル 2003 セル内...
-
エクセルで1つの会社名に対して...
-
【エクセル】1列内に複数ある同...
-
EXCELでの重複データカウント方...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
エクセルで1列に500行並んだデ...
-
複数の条件に合う行番号を取得...
-
エクセルで日付から日にちを削...
-
Excelで2つのデータの突合せを...
-
Excelで2行単位のソートの出来...
-
excel:別シートの値を飛び飛び...
-
エクセルで、重複データを除外...
-
Excelの30個ずつの平均値の出し方
-
Countifよりも早く重複数をカウ...
-
VBA 数式を最終行までコピー
-
エクセルVBA C列に特定の文字列...
-
エクセルで横並びの複数データ...
-
VBA 大きなtxtテキストファ...
-
エクセル~空白のセルのある行...
-
エクセル2016にて、行挿入&コピ...
-
500行の中から、多い順に抽出す...
-
エクセルで1つの会社名に対して...
-
Excel VBA 【QueryTables.Add】...
-
Excelでデーターが多いので、平...
-
Excelで社員の本名をニックネー...
おすすめ情報