増減するデータの集計について

質問

Excel2013使用です。

「受注書」というシートのデータを集計し、「集計表」というシートに
書き出したいです。

【シート「受注書」】

　　　C　　 　　　D　　　　　　E　 　　　　　F　　　　　G　　
1　商品名　　　色　　　　　数量　　　　単価　　　備考
2 データ・・・・・・・・・・・・・・・

【シート「集計表」】

　　　A　 　　　　B　　　　　　C　　　　　　D　　　　　E
6　商品名　　　色　　　　　数量　　　　単価　　　備考
7

シート「受注書」のC～Fのデータをコピーし、
シート「集計表」のA～Dに貼り付け後、商品名を基準に重複を削除し、
各商品の合計数量をSUMIF関数で集計するようにしました。

テストデータでは上手く行ったのですが、「受注書」のデータは都度
増減があるため、データを増やして再度テストしたところ、増やした分の
データが「集計表」の下部に残ってしまいます。

こんな感じ↓

【シート「集計表」】

　　　A　 　　　　B　　　　　　C　　　　　　D　　　　　E
6　商品名　　　色　　　　　数量　　　　単価　　　備考
7　*****　　　　**　　　　　***　　　　　***　　　　**
8　****　　　　 **　　　　　***　 ***　　　　**

12****　　　　　**　　　　　***　　　　　***　　　 **　←増やしたデータ

コードは以下の通りです

Sheets("受注書").Select
Range("C2:G2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("集計表").Select
Range("A7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveSheet.Range("$A$6:$E$25").RemoveDuplicates Columns:=1, Header:=xlYes
Range("C7").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Range("C7").Select
ActiveCell.FormulaR1C1 = "=SUMIF(受注書!C3:C5,集計表!RC1,受注書!C5)"
Range("C7").Select
Selection.AutoFill Destination:=Range("C7:C9"), Type:=xlFillValues
Range("C7:C9").Select
Range("A2").Select
End Sub

試しに
ActiveSheet.Range("$A$6:$E$25").RemoveDuplicates Columns:=1, Header:=xlYes

の部分を
ActiveSheet.Range("$A:$E").RemoveDuplicates Columns:=1, Header:=xlYes

に変えてみたところ、下部の重複データは消えたのですが、集計結果が何故か
A7以降にではなくA4以降に表示されてしまい、罫線も消えてしまいました。
更に、C列の数量に不要な0が表示されてしまいます。

こんな感じ↓

　　A　 　　　　B　　　　　　C　　　　　　D　　　　　E
4　商品名　　　色　　　　　数量　　　　単価　　　備考
5　*****　　　　**　　　　　***　　　　　***　　　　**
6　****　　　　 **　　　　　***　 ***　　　　**
7　　　　　　　　　　　　　　　　0
8 　　　　　　　　　　　　　　　 0

どこを直したら良いでしょうか？

回答No.5

kagakusuki · ベストアンサー

回答No.4です。

>「色」の列（シート：受注書ではD列、シート：集計表ではB列）は、 色指定の無い商品もあるため、空欄になる場合もあります。
>色の列が空欄の場合、SUMIFSの集計結果が「0」になってしまします。

　それでしたら、

"=SUMIFS(受注書!C5,受注書!C3,RC1,受注書!C4,RC2,受注書!C7,RC5&"""")"

の中のRC2と記されている所の条件式を、RC5の条件式と同様に & "" を付けて、

"=SUMIFS(受注書!C5,受注書!C3,RC1,受注書!C4,RC2&"""",受注書!C7,RC5&"""")"

という形にして下さい。

>マクロ実行後に「シート：集計表」の6行目に入力して いる項目名（A6：商品名、B6：色・・・等）が消えてしまいます。

　それはもしかしますと

.Range("A7:E" & .Range("A" & Rows.Count).End(xlUp).row).ClearContents

の所で指定するセル範囲を質問者様が間違えて

.Range("A6:E" & .Range("A" & Rows.Count).End(xlUp).row).ClearContents

などの様に古いデータを消去する範囲を6行目からにしてしまっているのではないでしょうか？
　或は、VBAの構文の記述は正しくても、項目名を入力している行を間違えて7行目の所に項目名を入力しておられるのではないでしょうか？
　後、おそらく関係ないと思いますが、RemoveDuplicatesのHeader:=xlYesとなっている所をxlYesではない別の設定値にしているという事はないでしょうか？

Sub QNo9222268_増減するデータの集計について_改()

With Sheets("集計表")
.Range("A7:E" & .Range("A" & Rows.Count).End(xlUp).row).ClearContents
End With
With Sheets("受注書")
.Range("C2:G" & .Range("C" & Rows.Count).End(xlUp).row).Copy
End With
With Sheets("集計表")
.Range("A7").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
.Range("A6:E" & .Range("A" & Rows.Count).End(xlUp).row) _
.RemoveDuplicates Columns:=Array(1, 2, 4, 5), Header:=xlYes
.Range("C7:C" & .Range("A" & Rows.Count).End(xlUp).row).FormulaR1C1 = _
"=SUMIFS(受注書!C5,受注書!C3,RC1,受注書!C4,RC2&"""",受注書!C7,RC5&"""")"
End With

End Sub

お礼

ありがとうございました！

お陰さまで無事解決しました。

項目名が消える件に関しては、

Range("A7:E" & .Range("A" & Rows.Count).End(xlUp).row).ClearContents

を

Range("A7:E7" & .Range("A" & Rows.Count).End(xlUp).row).ClearContents

に変更したら直りました。

本当に助かりました。

ありがとうございます。

月初で業務が忙しく、簡単なお礼しか言えず申し訳ありません。

本当に感謝申し上げます。

回答No.4

kagakusuki

まず、冒頭の所に「集計表」の古いデータを消去するための次の様な構文を付け加えて下さい。

With Sheets("集計表")
.Range("A7:E" & .Range("A" & Rows.Count).End(xlUp).row).ClearContents
End With

　それから、

Sheets("受注書").Select
Range("C2:G2").Select
Range(Selection, Selection.End(xlDown)).Select

などの様にコピー範囲を選択してコピーする際のVBAの構文も

With Sheets("受注書")
.Range("C2:G" & .Range("C" & Rows.Count).End(xlUp).row).Copy
End With

の様にまとめて書く事が出来ます。
　同様に

Sheets("集計表").Select
Range("A7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

の部分も

With Sheets("集計表")
.Range("A7").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
End With

の様にまとめて書く事が出来ます。
　また、Operationの部分もデフォルトでxlNoneの値となっていますので、xlNoneに設定する場合であれば、記述を省略してしまうだけで自動的にxlNoneに設定されますから、Operation:=xlNoneは不要です。(もしxlNone以外の設定にする場合にはOperation:=を省略する事は出来ません)
　同様に、SkipBlanks :=FalseとTranspose:=Falseもデフォルトの設定値なので省略してしまって構いません。

　それから、

ActiveSheet.Range("$A$6:$E$25").RemoveDuplicates Columns:=1, Header:=xlYes

としていたのでは、商品名だけでしか重複の判定を行っていませんから、商品名が同じデータの中で色違いや「備考に記述されると思われる特注条件」が異なるものを集計表に反映させる事が出来ませんから、次の様にされた方が良いと思います。

With Sheets("集計表")
.Range("A6:E" & .Range("A" & Rows.Count).End(xlUp).row) _
.RemoveDuplicates Columns:=Array(1, 2, 4, 5), Header:=xlYes
End With

　同様に

"=SUMIF(受注書!C3:C5,集計表!RC1,受注書!C5)"

という関数も、商品名だけしか合計の条件としていないため、商品名が同じデータの中で色違いや「備考に記述されると思われる特注条件」が異なるものを集計値に反映させる事が出来ませんから、SUMIF関数ではなくSUMIFS関数を使った次の様な関数にされた方が良いと思います。

"=SUMIFS(受注書!C5,受注書!C3,RC1,受注書!C4,RC2,受注書!C7,RC5&"""")"

Sub QNo9222268_増減するデータの集計について()

With Sheets("集計表")
.Range("A7:E" & .Range("A" & Rows.Count).End(xlUp).row).ClearContents
End With
With Sheets("受注書")
.Range("C2:G" & .Range("C" & Rows.Count).End(xlUp).row).Copy
End With
With Sheets("集計表")
.Range("A7").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
.Range("A6:E" & .Range("A" & Rows.Count).End(xlUp).row) _
.RemoveDuplicates Columns:=Array(1, 2, 4, 5), Header:=xlYes
.Range("C7:C" & .Range("A" & Rows.Count).End(xlUp).row).FormulaR1C1 = _
"=SUMIFS(受注書!C5,受注書!C3,RC1,受注書!C4,RC2,受注書!C7,RC5&"""")"
End With

End Sub

補足

とっても丁寧なアドバイスを頂き、ありがとうございます。

私はVBAはほとんど理解しておらず、マクロの自動記録で作った
ものに少し手を加えただけのコードなので、色々とおかしな点や
洗練されていない箇所が多々あると思います。

今は会社なので、自宅に帰ったら再度じっくり拝見して勉強させて
頂きます。

さて、ご教示いただいたコードを早速試させて頂いたところ、無事
「下の方に増えたデータが残る」問題は解決しました。

が、あと少し問題があります。

私の説明不足で申し訳ありませんが、
「色」の列（シート：受注書ではD列、シート：集計表ではB列）は、
色指定の無い商品もあるため、空欄になる場合もあります。

色の列が空欄の場合、SUMIFSの集計結果が「0」になってしまします。

もう１点は、マクロ実行後に「シート：集計表」の6行目に入力して
いる項目名（A6：商品名、B6：色・・・等）が消えてしまいます。

すみませんが、私ではどう直したら良いか分からないので、再度
教えて頂けないでしょうか。

何とぞよろしくお願いいたします。

回答No.3

Prome_Lin

とりあえず、２～３行目を変更してみてください。
Range("C2:G" & Range("C1").End(xlDown).Row).Select
' Range(Selection, Selection.End(xlDown)).Select←この行は不要で、上の行のセレクト範囲を「C2:G2」固定ではなく、データのある最終行にしてください。

回答No.2

kkkkkm

Sheets("集計表").Select
の後に
Range("A7:E7").Select
Range(Selection, Selection.End(xlDown)).Clear
として貼り付ける前に前回のデータを消せばいいのではないでしょうか。

回答No.1

shintaro-2

何をされたいのか良く理解できませんが、
ピボットテーブルでは駄目なのですか？