エクセルマクロの件（２）

質問

お世話になります。
先日このサイトで教えていただき（No.3433483）、下記のようなマクロができました。
その節はありがとうございました。

マクロ実行したところ、１回目は問題なく動作し、マクロ実行によって作成されたデータを削除し、改めて実行すれば問題ありませんでした。

ただ、2回目以降（一覧データを削除せずそのまま実行）マクロを実行すると、毎回180行以降のデータが重複するようになりました。
3回実行すると、180行より前のデータは1行のみの表示ですが、181行目以降のものは3行同じデータが記載されるということです。

全てのデータが重複するのであれば分からなくはないのですが、一部分のみの重複なので意味が分からなくなってしまいました。
（マクロの中にそう処理するよう記載があるのだと思いますが素人のため分かりません；）

理由の分かる方がいらっしゃいましたらご指摘いただければと思いますのでよろしくお願いします。

Dim ptr As Integer
Sheets("シートA").Activate
ptr = Range("A65536").End(xlUp).Row
Range("A4:P" & ptr).Copy Destination:=Sheets("一覧").Range("A4")

Sheets("シートB").Activate
ptr = Sheets("シートB").Range("A65536").End(xlUp).Row
Range("A4:P" & ptr).Copy Destination:=Sheets("一覧").Range("A65536").End(xlUp).Offset(1, 0)

Sheets("一覧").Activate
Range(Cells(4, "A"), Cells(Range("A65536").End(xlUp).Row, "P")).Sort _
Key1:=Range("D4"), Order1:=xlAscending, Key2:=Range("E4"), _
Order2:=xlAscending, Key3:=Range("F4"), Order3:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, SortMethod:=xlPinYin, DataOption1:=xlSortNormal, _
DataOption2:=xlSortNormal, DataOption3:=xlSortNormal

'
End Sub

回答No.4

hana-hana3 · ベストアンサー

＞ただ、当然ながらタイトル（1～3行目迄記載あり）も見事に消えました（笑）

シートの仕様が解らなかったので、単純にシートをクリアするための命令を書いてしまいました・・・。

＞とりあえず、3行目までは残してそれ以降を消去するといった方法を考えてみたいと思います。

こんな感じでしょうか。
Sheets("一覧").Activate
Range(Range("A4:O4"), Range("A4").End(xlDown)).ClearContents

＞希望は全て「上書き」です。

適切な回答を得るためにも、質問時にはある程度の仕様を明記するのが一番かと思います。
質問されるかたの利用方法もマクロ作成のレベルも判別できないので、質問文から読めない部分のコードまで書いてくれませんからね。

前回は『Ｂのデータを貼り付ける位置で問題が発生しています。』と言う質問だったので、その部分を改善した幾つかの回答が寄せられました。
貼付け側のシート内容（タイトルの有無等）も解らないので、貼付け前に必要な作業（消去）を省いて回答したまでです。
（利用者がそれなりの対処をするだろうという思惑もありますが・・・。）

お礼

タイトルが消えた件は自分の馬鹿さ加減に呆れて書いたものでしたが、事情を説明しなければ分からないですよね。
大変申し訳ありませんでした。

自分の無知さ故に質問も満足にできませんでした。
そんな中でも親切に教えていただき感謝しております。

以後自分に未知の部分ではその説明からさせていただきたいと思います。

回答No.6

imogasi

私も前回の質問の回答をしているようです。
私も２通り回答しており、もう一方のご回答も有ります。
ざっと自分のコードを見直したところ、１８０行うんうんでひっか理そうなコードは無いようです。
ーー
後は実際のデータとの関連で、止まったり、意図どおりではないケースです。これも回答のコードが不十分といえば不十分なんですが。
本件はこれに該当し、単純なコードミスではないようです。
あと質問者のケースにコードをチューニングするときの誤解などです。
ーー
すぐ頭に浮かんだのはかき２点です。
いつも
Range("A65536").End(xlUp).Row
Usedらんげ
CurrentRegion
を回答で使うときは、下の行に余分なもの（別の表とか、フッタ的注釈など）、中間に空白行が、無いことを祈って回答してますが、それが１つ。
ーー
それと第2シートに累積しているので、テストなどを繰り返すと
前回のものも累積していく。（クリアするコードを入れると累積にならない。）
そんなことを思いました。
ーー
もう改善方法は今回の皆様のご指摘で判ったようですね。
前回答の、どの分を採用されたのか書いてないのですが、
私の回答と関係なければ無視してください。
関係あればすみません。

お礼

前回の質問にもお答えいただきありがとうございました。
最終的には前回の#3さんのお答えを参照させていただきました。

180行というのはデータの量の問題でしたのでこちらの問題でした。
申し訳ありません。

改善方法はあと1点（色のクリア）がはっきりしませんが、自分でも
考えてみたいと思います。

回答No.5

zap35

＃０３です
＞色ごと消去できる方法を
ClearContentsメソッドをClearメソッドに変えるだけです。

これは＃０２さんの回答に既に出ています。「タイトルも見事に消えてしまった」ということですからClearメソッドは試されたのですね。ちゃんと色も消えませんでしたか？

一から十まで聞くのではなかなか上達しませんよ。

お礼

ありがとうございます。
clearにすればいいのかなと思い試してはみましたが、消えなかったんです。
ちなみに現在の追加した部分は
Sheets("一覧").Activate
Range(Range("A4:P4"), Range("A4").End(xlDown)).Clear
となっています。

でも、確かに#2さんのご指摘の時は全て（きれいさっぱり）消えました。
なかなか難しいですね^^;

補足

すいません、順番が逆になってしまいましたが。

改めてやってみたらClearで全て消去できました。
何度もやってできなかったんですが、前の履歴か何かが残っていたのかもしれません。

皆様何度もありがとうございました。

回答No.3

zap35

２回目以降の実行時に期待する動作をしないのは、他の回答者さまも書かれているようにシートＡの内容を貼り付けるのは「一覧シートのＡ４セル」で、シートＢの内容を貼り付けるのは一覧シートの最終行の下のセルだからです。元々一覧シートにデータがあり、シートＡのデータ行数が少ない場合は前のデータが残ってしまいますね。

いかようにも作り替えはできますが「どうしたい」がないと回答しづらいですね。

Sheets("一覧").Activate
Range(Cells(4, "A"), Cells(Range("A65536").End(xlUp).Row, "P")).ClearContents

の２行をDim宣言の直後に挿入すれば、一覧シートのデータを予め削除してから貼り付けることができます。

お礼

ありがとうございます。
データの削除を自分で考えてみましたがやはり無理でした・・・
おっしゃるとおりの記載をマクロにしたところ無事以前の一覧は消去され毎回同じ一覧が作成されるようになりました。

ただ、この2行の追加だとデータのみの消去ですよね。
大変申し訳ありませんが、シートＡとＢのデータには行ごとに
色づけがしてあるんです。
現状だと色がそのまま残ってしまうので、色ごと消去できる方法を
ご指摘いただけないでしょうか。

希望は、マクロ実行時、以前作った一覧は一覧ごと全て消去し、最新の一覧が作りたい。ということです。

回答No.2

hana-hana3

１回目の貼付けでは、Ａ４を基準に貼付けます。
２回目の貼付けでは、Range("A65536").End(xlUp).Row.Offset(1, 0)でシートのデータの最下端＋１行目を基準にしています。

１回目のデータが仮に１行の貼付けだったとしても、シートには前回のデータがあるので、２回目は残りデータの最下端＋１行目から貼付く事になります。

このマクロは、何もデータの無いシートを対象に動作するようになっているので、データが重複しないようにするためには、転記前にシートの初期化（消去）を行わなくてはなりません。

コピー開始前に、
Sheets("一覧").Cells.Clear
と書き加えて下さい。

お礼

ありがとうございます。

早速やってみましたが、きれいに消去ができました。
ただ、当然ながらタイトル（1～3行目迄記載あり）も見事に消えました（笑）
とりあえず、3行目までは残してそれ以降を消去するといった方法を考えてみたいと思います。

回答No.1

nekoron07

マクロ記述の4行目の

Range("A4:P" & ptr).Copy Destination:=Sheets("一覧").Range("A4")

から、「シートＡ」のデータは、常に「一覧」のセルA4の位置に貼り付けられるようになっており、

また、7行目の

Range("A4:P" & ptr).Copy Destination:=Sheets("一覧").Range("A65536").End(xlUp).Offset(1, 0)

から、「シートＢ」のデータは、常に「一覧」の最終行の次の行位置に貼り付けられるようになっていますので、「一覧」を削除しないままマクロを実行するとシートＡ部分は「上書き」、シートＢ部分は「追加」されるようになっています。

質問者様はどのようにしたいのでしょうか。
もし、シートＡも最終行の下に追加したい、というのでしたら、4行目を

Range("A4:P" & ptr).Copy Destination:=Sheets("一覧").Range("A65536").End(xlUp).Offset(1, 0)

とすれば、シートＡのデータも「上書き」ではなく一覧に「追加」できます。

お礼

ありがとうございました。
希望は全て「上書き」です。そのためには一度全てのデータの消去をすればいいみたいですね。