隣の列の最終行と同じ行までコピーしたい

質問

Excel2013 使用です

※私はVBAは使えませんが、マクロの記録は出来ます。
　 記録したマクロに、ネットで見つけたコードを加えたりします。
　 今回は、それで上手く行かなかった所についての質問です。

画像を元に説明します。

【目的】
元々はU列までしか無いデータに、マクロを使ってW列以降に集計を出したい。

【作ったマクロ】
Q列とR列の重複を削除した物をX列とY列に表示
SUM IF関数を使って、W列を元にS列を集計した数をY2セルに表示
セル「AA2」に、「Z2」-「Y2」列の数式を入れる

…ここまでは上手く行きました。

問題は、Y2に入れたSUMIF関数と、AA2に入れた引き算を
「W列の最終行と同じ行」までコピーしたい」という所です。
（元になるU列までのデータの行数は、つど増減があるため）

そこで、ネットで見つけた以下のコードを使ってみました。

Range("Y2").Select
ActiveCell.FormulaR1C1="=SUMIF(C17:C19,R23,C19)"
Range("Y2").Select
With Cells(Rows.Count,"X").End (xlUp)
Selection.AutoFill Destination:=Range(Selection,Cells(.Row,"Y")),Type:=xlFillCopy

上のコードを使うと、画像で言うと6行目までは正しい数が表示されます。
が、何故かその下に0000・・・と続き、更に下の方によく分からない表示が
出てしまいます。

恐らく、Y列はS列を元に集計しているせいだと思うのですが、VBA自体の意味は
さっぱり分からないのでどう直したら良いのか分かりません。

（ちなみに、R列の商品名はQ列の商品コードを元にvlookupで出していますが、
R列は上記のコードを使って正常にQ列と同じところまでコピー出来ています）

どなたかご教示いただけたら助かります。

回答No.10

kkkkkm · ベストアンサー

すでにお気づきだとは思いますが、先にNo7で間違いがありましたので訂正しておきます

その時に10行以降にデータが表示されたときに黄色で反転しているコードの部分が不要(もしくは何かの間違い)な部分ですので

を

その時に10行以降にデータが表示されたときに黄色で反転しているコードの「一行上の」部分が不要(もしくは何かの間違い)な部分ですので

に訂正します。

さて、
> の「("$W$1:$X$53")」の53の部分が怪しいと思います。

質問の画像の10行目以降にあるものは、実際54行目以降にあったものを表示上の理由で10行目に手入力で持って行ったということでしょうか?　よく見るとみかんの合計もおかしいですし。

Q列R列の54行目以降にデータがあると、W列X列の54行目以降にデータが貼り付けられて「Q列とR列の重複を削除」の操作からは外れますので、結果54行目以降にデータは残ります。

Q列R列のすべてのデータを対象とするのでしたら

ActiveSheet.Range("$W:$X").RemoveDuplicates Columns:=1, Header:=xlYes

としてやれば済みますが、何かの都度Q列R列のデータを消して再度記入し実行するという操作をする場合、下の方を消し忘れた場合、その不要なデータも集計に入ってしまいます。

消し忘れを削除する場合
Columns("Q:R").Select
の前に
With Cells(2, "Q").End(xlDown)
Range(Cells(.Row + 1, "Q"), Cells(Rows.Count, "Q")).ClearContents
Range(Cells(.Row + 1, "S"), Cells(Rows.Count, "S")).ClearContents
End With
としておけば1行目から連続してデータが入っている最終行の次の行から最終行までのデータを削除できます。

お礼

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

最初にマクロを作り始めたブックが開いてしまう件は、今日も検証する暇が
無かったのでこの質問はこれで完了とさせて頂きます。
もし解決しなかったら、時間が出来た時に別の質問としてまた投稿します。
今回の元々の質問の目的はちゃんと達成できたので、本当に助かりました。
これを機に、私もVBAを勉強してみたいと思います。
何度もお返事いただき、本当にありがとうございました。
これで仕事の効率を上げることが出来ました。
心から感謝いたします…！

補足

ありがとうございます！！
お陰さまで無事解決しました☆
何度も本当にありがとうございました。
心から感謝です！

…あの、もう一つだけ聞いても良いでしょうか？(>_<)
今回のマクロは、最初にAというブックで作り始め、途中でAをブックごとコピーした
ブックBを作り、その後のマクロの修正は全てブックBで行ってきました。

今はブックBしか使ってないのですが、ブックBを開くと自動でブックAも開いて
しまいます。

ネットで調べて、マクロをアドイン？アドオン？に登録して、どのブックからも
同じマクロが使えるようにしたのですが、それでもやはりブックAが開いてしまいます。

実はマクロは2つ作っています。
1つのマクロであまり複雑な処理をしてしまうと、不具合が出た時に原因の特定が
難しいと思ったからです。

マクロ1は、ブックAの時から内容は変わってません。
マクロ2は、ブックBを作った後で修正しました。

つまり、マクロ1も2も両方のブックに入っているけど、マクロ2に関しては
ブックBの物が最新版という状況です。

たぶん、マクロ1がブックAに依存してるせいで？ブックAが開いてしまうのでは
ないかと思いますが、どうしたら良いでしょうか…。

もうこれ以上無理でしたら、別の質問として再度投稿しますので、無理にお答え
頂かなくても大丈夫です。

回答No.11

kkkkkm

> たぶん、マクロ1がブックAに依存してるせいで？ブックAが開いてしまうのでは
> ないかと思いますが、どうしたら良いでしょうか…。

依存しているというのがどのようにしているのか不明ですが、依存しているのでしたらブックAを開かないとマクロが正常に動かないでしょうし、依存を解消できるのでしたら、その部分を手直しするしかないと思います。

マクロの内容にブックAを絶対指定しているところがありブックB指定でも問題がない場合
Workbooks("ブックA.xlsm")
とか記載されているのでしたら
ThisWorkbook
に変更することでブックA依存は避けられます。

どちらにしても、開くタイミングを見つけてそのあたりに何かないか調べるしかないですね。

回答No.9

kkkkkm

No8の補足です。

ActiveSheet.Range("$W$1:$X$53").RemoveDuplicates Columns:=1, Header:=xlYes
を
ActiveSheet.Range("$W$1:$X$53").RemoveDuplicates Columns:=2, Header:=xlYes
にしてみたらどうなるでしょう。

変化がなければ、もしかしたらBookが壊れているのかもしれませんので、現在のブックのコピーを取っておき、新規のエクセルを開いてファイルを開くで最近使ったブックからではなくコンピューターから該当のファイルを探して開くの所で▼をクリックして「開いて修復する」を試してみてください。

また、コードに異常はないと思いますので確認のために質問の画像にあるQ1からR9までをコピーして新しいBookを作成してそれに貼り付けシート名を作業用にしてください。シートのコピーで新しいブックという操作で新しいBookは作成しないでください。

それで、No7の補足に記載していただいたコード、「Q～R列をW～X列にコピーして、そこから重複を削除し、ソートして並べ替える」の部分だけを新しいBookのマクロにコピペして実行してみてください。

回答No.8

kkkkkm

> …のどこかに不備があることになりますね。

わたしの所でやってみて異常はないのですが・・・

とりあえず一番上にある
Columns("Q:R").Select
の所を茶色にして実行させてそこで一時停止してそこからF8キーでステップ実行させながらどこで10行目以降が表示されるのか確認してください。

ちなみに、すべて作業用シートを表示したままで実行してるのですよね。

補足

引き続きありがとうございます。
今日は業務が忙しくてゆっくり検証出来ませんでしたが、1行ずつの実行を
やってみました。
ちょっと記憶が定かではありませんが、確か
ActiveSheet.Range("$W$1:$X$53").RemoveDuplicates Columns:=1, Header:=xlYes
の後の
ActiveWorkbook.Worksheets("作業用").Sort.SortFields.Clear
で、不要な行が下部に表示されることがわかりました。
そこで気がついたのですが、Q～S列は行数が一定ではないので、「テストデータの
Q～S列に行を足してキチンと処理できるか？を試している」というのが今やっている
事で、その「増やした行」がW～X列の下部に残っているのだと気がつきました。
つまり、
ActiveSheet.Range("$W$1:$X$53").RemoveDuplicates Columns:=1, Header:=xlYes
の「("$W$1:$X$53")」の53の部分が怪しいと思います。
ここの行数が、都度の変化に対応出来ていないせいではないでしょうか…？

回答No.7

kkkkkm

補足に記載していただいたコードでは10行目以降にデータが出ることはなくangelnavi さんの期待する動作になっています。

> 中間部分は多分いらないと思うので

この部分に不要な部分あると思われます。添付画像の茶色の〇部分になっているところ(前半部分の最後です)をクリックすると添付画像のようになり、そこでコードの実行が中断される設定になります。それでマクロを実行して中断されたときには「Q列とR列の重複を削除した物をX列とY列に表示」の状態になっていると思います。

その後、F8キーを押すとコードがワンステップずつ実行されますので、ワンステップごとにシートを見て中間部分で何が実行されているのか確認してください。その時に10行以降にデータが表示されたときに黄色で反転しているコードの部分が不要(もしくは何かの間違い)な部分ですので、行頭に'を入力しコメントにしてください。

さっきの茶色を再度クリックして茶色の反転状態を解除して、マクロを実行して正常に動くか確認してください。

補足

ありがとうございます。
早速やってみました！
画像でご指示いただいた、まさにその箇所で一度止めてみたところ、
その段階で既に10行目以下に商品コードと商品名が入ってしまう事が
わかりました。

まだ、SUMIF等実行する前の段階です。

つまり、「Q～R列をW～X列にコピーして、そこから重複を削除し、ソートして並べ替える」

Columns("Q:R").Select
Selection.Copy
Columns("W:W").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("W:X").EntireColumn.AutoFit
Range("W2").Select
Application.CutCopyMode = False
Columns("W:X").Select
ActiveSheet.Range("$W$1:$X$53").RemoveDuplicates Columns:=1, Header:=xlYes
ActiveWorkbook.Worksheets("作業用").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("作業用").Sort.SortFields.Add Key:=Range("W2:W53"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("作業用").Sort
.SetRange Range("W1:X53")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

…のどこかに不備があることになりますね。

回答No.6

kkkkkm

> なので、画像で言うところの6行目までで終わるコードを教えて頂ければ
とても嬉しいです。

そこだけのコードを記載しても、マクロをご存じなければどこに入れていいのか、現在のどこを削除すればいいのかがわからないと思います。

現状は
＊Q列とR列の重複を削除した物をX列とY列に表示
＊SUM IF関数を使って、W列を元にS列を集計した数をY2セルに表示
＊セル「AA2」に、「Z2」-「Y2」列の数式を入れる
この部分のコード(もしくはこの部分と「「W列の最終行と同じ行」までコピーしたい」コードの間にある何か)に何かしらに不備があるので、W列とX列の10行目以降に商品コードと商品名が記入されてしまっています。

上記の＊印部分から質問に書かれた部分までを含めたコードを記載してみてください。入力時には手入力せずにエクセルのコードをそのままコピーペーストしてください。

補足

ありがとうござます。
なるほど！確かにそうですね。
ご提示頂いたコード以外の部分が間違っている可能性がありますね。

ただ、今は会社ではないので＊部分のコードが分かりません。
明日、また会社から報告させて頂きます。

根気強くお付き合い頂きありがとうございます。
よろしくお願いいたします。

回答No.5

kkkkkm

> つまり、不要な行（画像で言うと7行目以下）に「0000」が入り、
> その下に不要な項目が表示されてしまいます。。

W列とX列の10行目以降にみかんなどが表示されていますが、これはいらないという事ですか？
質問では
> Q列とR列の重複を削除した物をX列とY列に表示
(X列Y列はW列X列の書き間違いだと思ってます)
これはうまくいったという事でしたが、10行目以降がいらないという事でしたらこの部分がうまくいっていないということになります。

質問で示されたコードは
Y2にSUMIF関数を入力してY2の式をX列の最後のデータのある行までコピーする
ですのでY12までコピーされてコードは正常です。

W10以降のデータが必要でSUNIF関数だけ不要でしたら
With Cells(Rows.Count,"X").End (xlUp)
を
With Cells(2, "X").End(xlDown)
に変更してください。

補足

お返事ありがとうございます。
さっそく試させて頂いたところ、7行目以下の不要な000・・は消えました！

ただ、私の質問の仕方が悪かったですが、10行目以降も要らないのです。
Q～S列は、実際の表では100行位のデータが入っています。
その中に、同じ商品名が繰り返し出てくる（数は違う）ので、W列以降に
その集計を出そうとしているのです。

画像で言うと、WとX列の6行目までが、Q列とR列の重複を削除した物です。
後は、その横のY列に、S列を集計した数字が入るだけで良いのです。
そして、AA列にZ-Yが入れば完成です。
それ以外は必要ないのです。

なので、画像で言うところの6行目までで終わるコードを教えて頂ければ
とても嬉しいです。

回答No.4

imogasi

下記は直接の回答とは言えないのは承知してますが、
もうマクロの記録方式をやめて、VBAを勉強してはどうですか。
それと
（１）１つのセルに関数式を入れる
（２）１セルの式の多数のセル（行か列方向へ）式の複写
の仕組みに頼るのではなく、VBAを勉強したらよい。
R1C1形式など複雑な点に関心が行く必要もない。
質問もこんなに複雑にならない。
時間のある時下記を読んで、何か啓発されるものがあれば幸いです。
ーー
エクセルのシートのデータで、基本的なことは下記で尽きるように思う。
A列、B列にデータがあって、データのある最終行まで計算をするのは
Sub test01()
lr = Range("A1000").End(xlUp).Row
MsgBox "データ最終行は　" & lr
For i = 2 To lr '第１行目は見出しとする
Cells(i, 3) = Cells(i, 1) + Cells(i, 2) 'C列にA列とB列の和を入れる
Next i
End Sub
A列からデータのある列までのセルの数値の和をだす
Sub test02()
lr = Range("A1000").End(xlUp).Row
lc = Range("xfd2").End(xlToLeft).Column
MsgBox "データ最（右）終列は " & lc
For i = 2 To lr
For j = 1 To lc '第１行目は見出しとする
Cells(i, lc + 1) = WorksheetFunction.Sum(Range(Cells(i, 1), Cells(i, lc))) 'C列にA列とB列の和を入れる
Next j
Next i
End Sub
ーーー
ここでよく使えるのは
lr = Range("A1000").End(xlUp).Row
lc = Range("xfd2").End(xlToLeft).Column
の手法
この質問も、これを聞いているのかな。
ーー
Cells(i, 1) + Cells(i, 2)　　や
WorksheetFunction.Ｓｕｍの部分は
行数や列数が少ない場合は代数的な＋－など式で、
多い場合はＲａｎｇｅとVBA関数を使って処理する。
ーー
上記のやり方の特徴として
これらは（セル対象の）繰り返し方法という基本的なロジックです。
ーー
関数と違って、あるセルの値が変わった時は、再度実行しないとならない。
これがVBAが、ワークシート関数に比べて嫌われる理由らしいが。
そして質問者のやっているのは、関数式埋め込み法といえると思う。

補足

ご提案、並びに色々教えていただきありがとうございます。
VBA、勉強してみたいと思っています。
ただ、0からの勉強になるので時間が必要ですが、今回の質問は
急を要しています。
…一つお伺いしたいのですが、私が希望している内容は、VBAで
「可能」なのでしょうか？それとも「不可能」ですか？

回答No.3

kkkkkm

No2の補足です。
> AA2に入れた引き算を「W列の最終行と同じ行」までコピーしたい

を忘れてました。SUMIF関数と引き算を最終行までコピーするコードです。

Range("Y2").FormulaR1C1 = "=SUMIF(C[-7],RC[-1],C[-6])"
Range("AA2").FormulaR1C1 = "=RC[-1]-RC[-2]"
With Cells(Rows.Count, "X").End(xlUp)
Range("Y2").AutoFill Destination:=Range(Cells(2, "Y"), Cells(.Row, "Y")), Type:=xlFillCopy
Range("AA2").AutoFill Destination:=Range(Cells(2, "AA"), Cells(.Row, "AA")), Type:=xlFillCopy
End With

なお
Range("Y2").FormulaR1C1 = "=SUMIF(C[-7],RC[-1],C[-6])"
は
Range("Y2").Formula = "=SUMIF(R:R,X2,S:S)"
に
Range("AA2").FormulaR1C1 = "=RC[-1]-RC[-2]"
は
Range("AA2").Formula = "=Z2-Y2"
にしても同じです。R1C1よりR1C1なしの方がわかりやすいかもですね。

補足

早速のご回答ありがとうございました。
多忙で返事が遅くなって申し訳ございません。
ご提示いただいたコードを使ってみましたが、結果は以前と
全く同じになりました。
つまり、不要な行（画像で言うと7行目以下）に「0000」が入り、
その下に不要な項目が表示されてしまいます。。

回答No.2

kkkkkm

> 上のコードを使うと、画像で言うと6行目までは正しい数が表示されます。

コードは実際のコードそのままですか?
としたら、正しく表示されるはずはないと思いますが・・・
Y2に記載されている式はどのようになっていますか？
そのコードのままだと以下の式になってしまいます。
=SUMIF($Q:$S,$23:$23,$S:$S)

ActiveCell.FormulaR1C1="=SUMIF(C17:C19,R23,C19)"
を
ActiveCell.FormulaR1C1 = "=SUMIF(C[-7],RC[-1],C[-6])"
こちらに変更してみてください。

補足

すみません。
直近のコメントで補足の補足が入力出来なかったため、こちらの
古いコメントにコードを記載させて頂きます。
↓が、コードの前半部分です。

Columns("Q:R").Select
Selection.Copy
Columns("W:W").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("W:X").EntireColumn.AutoFit
Range("W2").Select
Application.CutCopyMode = False
Columns("W:X").Select
ActiveSheet.Range("$W$1:$X$53").RemoveDuplicates Columns:=1, Header:=xlYes
ActiveWorkbook.Worksheets("作業用").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("作業用").Sort.SortFields.Add Key:=Range("W2:W53"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("作業用").Sort
.SetRange Range("W1:X53")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

中間部分は多分いらないと思うので、↓が後半部分です。

Range("Y2").FormulaR1C1 = "=SUMIF(C[-7],RC[-1],C[-6])"
Range("AA2").FormulaR1C1 = "=RC[-1]-RC[-2]"
With Cells(2, "X").End(xlDown)
Range("Y2").AutoFill Destination:=Range(Cells(2, "Y"), Cells(.Row, "Y")), Type:=xlFillCopy
Range("AA2").AutoFill Destination:=Range(Cells(2, "AA"), Cells(.Row, "AA")), Type:=xlFillCopy
End With
Range("AA2:AA15").Select
Range("W2").Select
Columns("Q:Q").EntireColumn.AutoFit
ActiveWindow.LargeScroll ToRight:=-1
ActiveWindow.SmallScroll ToRight:=-2
Rows("1:1").Select
Range("F1").Activate
Selection.AutoFilter
Selection.AutoFilter
Range("W2").Select
End Sub

よろしくお願いいたします。

回答No.1

trytobe

『問題は、Y2に入れたSUMIF関数と、AA2に入れた引き算を
「W列の最終行と同じ行」までコピーしたい」という所です。』

マクロでなくて手作業で、

・W2からAA2までを選択して、コピー(C)
・「end キー」を押して、「Shift キー」を押したまま「↓キー」で、W列の最終行まで一気にジャンプ全選択
・すべての行に、貼り付け(P) で、W2からAA2まで をそれぞれの行に対応した内容で入力完了

では不十分でしょうか。

補足

ご提案ありがとうございます。
ただ、今回は手作業の手間をなるべく減らすのが目的です。
とは言え、上手く行かない場合はやむを得ないので手作業に
するかもしれません。
ありがとうございます。