[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『検索結果を規定の表にコピーする』（たかなし）
この質問はHANA様 みやほりん様のご協力によって解決していただきました。 大変参考になりました。 ありがとうございます。
こんにちは。はじめまして。 今週エクセルのマクロの便利さに興味を持ち、マクロの記録とこちらの諸先生方の マクロを参考に自分なりにどうにか動くマクロをコピペで作ってみました。 結果だけ見れば満足なのですが、もっとスマートになるよう勉強したいと思い、 恥ずかしながら投稿させていただきす。
【状況説明】 Sheet 行数表 Sheet 整形 Sheet 搬送搬送予定表 の3つのシート構成
【行数表】 1 2 3 4 56 7 8 9 10 2 原 料 表 A 原 料 表 B 3 コード 品名 行数 数量 コード 品名 行数 数量 4 450020 ミント 60 500 325241 ボトルA 12 100 5 450040 ナツメグ 12 100 552453 キャップ黒 5 10000 6 450010 アルコール 79 1000 854657 ラベル細 102 3000 〜〜〜〜
各表とも100以内の行数で変動あり。 数量はHLOOKUPを使って別のブックにある計画表から日付を検索値に参照したもの。 並び替えも可能。
【整形】 行数表のデータを整形するために一時的にコピーするためのシート
【搬送予定表】 罫線による表で、行数表のデータをR8C2〜R27C4の範囲に貼り付ける
【やりたいこと】 行数表の表「原料表A」と「原料表B」の数量が入力されているデータを抜き出し コード、品名、数量だけをSheet搬送予定表にコピーし、コード順に並び替えたい。 数量が入力されている行は20を超えることはない。
【自分のやり方】 原料表Aを数量を降順で並べ替え、上から20行コピーし整形表に貼り付ける 原料表Bも同上に、整形表に貼り付けた原料表Aのコピーの下の行に貼り付ける 整形表を数量で並び替える 行数列を削除する もし、数量が0より小さければコード、品名、数量に""を代入する コード順に並び替え、上から20行をコピーする 搬送予定表の所定の位置に貼り付ける
以上です。
下記が標準モジュールに書いてあるプログラムです。
Sub 並び替え整形コピーペースト()
Dim shA As String, shB As String, shF As String Dim rwA As Long, rwB As Long, rwC As Long Dim i As Long, rn As String, endR As Long, endD As Long Dim t, cr
shA = "行数表"
shB = "整形"
shF = "搬送予定表"
rwC = 1
rn = "D4"
t = 3
Sheets(shB).Cells.ClearContents
With Sheets(shF)
.Range(.Cells(8, 2), .Cells(27, 4)).ClearContents
End With
For i = 1 To 7 Step 6
rwA = Sheets(shA).Cells(1000, i).End(xlUp).Row + 1
With Sheets(shA)
.Range(.Cells(t, i), .Cells(rwA, i + 3)).Copy
End With
Sheets(shB).Cells(rwC, 1).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
rwC = Sheets(shB).Cells(500, 1).End(xlUp).Row + 1
rn = "J4"
t = t + 1
Next i
With Sheets(shB)
rwC = Sheets(shB).Cells(1000, 1).End(xlUp).Row
cr = 5
.Columns("C:C").Delete Shift:=xlToLeft
.Cells(1, 5) = "数量"
.Cells(2, 5) = "<>0"
.Range(.Cells(1, 1), .Cells(rwC, 3)).AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
Range(.Cells(1, 5), .Cells(2, 5)), Unique:=False
End With
With Sheets(shB)
.Range(.Cells(2, 1), .Cells(2, 1).End(xlDown).End(xlToRight)).Copy
End With
With Sheets(shF)
.Cells(8, 2).PasteSpecial Paste:=xlValues
.Range(.Cells(8, 2), .Cells(27, 4)).Sort Key1:=.Range("B8"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
:=xlPinYin
.Cells(8, 2).Select
End With
With Sheets(shB)
.ShowAllData
.Cells.ClearContents
End With
End Sub
以上を元に、「こっちのほうがいいんじゃない」とか「これは無駄」などありましたら編集してコメント残していただければうれしいです。 他の人の間違いを探すことが難しいことは重々承知しておりますが、何卒お力添えいただきたいです。
できるだけ細かく書くよう心がけておりますが、必要な情報がありましたら聞いていただけたらと思います。 また、レスが遅くなることをご容赦くださいませ。 宜しくお願いいたします。
Selectメソッドと、その直後に取得されているSelectionプロパティは
おおむね省略することが出来ます。
Sheets(shA).Select
Range(Cells(4, i), Cells(rwA, i + 3)).Select
Selection.Sort Key1:=Range(rn), Order1:=xlDescending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
:=xlPinYin
上記は、下記のようにまとめることが出来ます。
With Sheets(shA)
.Range(.Cells(4, i), .Cells(rwA, i + 3)).Sort _
Key1:=.Range(rn), Order1:=xlDescending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
:=xlPinYin
End With
また、 Application.CutCopyMode = False もコピー・切り取りした範囲の
カットコピーモード（コピーした後、セル範囲の周囲の破線が点滅する状態）
を解消するだけのものです。この後に何かデータの内容変更を伴うような
メソッドの実行があれば自動的にカットコピーモードは解消されるので、だ
いたいの場合、省略できます。
(みやほりん)(-_∂)b
原材料Ａ、原材料Ｂ それぞれを ２０ずつコピーして貼り付けて居られる様ですが 全体で数が入っている行が最大４０行と決まっているなら
とにかく、原材料Ａの下に原材料Ｂを貼り付けて 数量で大きい順に並べ替えた後 上から40行分に付いて 数量0の削除とコードでの並べ替えを行い その範囲を搬送予定表に貼り付け
でも良いのかな・・・と思いました。
現在４回行われている並べ替えが、 ２回に成る ってだけですけどね。
あとは、 数量で降順に並べて「0」の物をある程度減らしてから・・・・ としなくても オートフィルタを設定して「0」以外の物を表示させる でも良いのかな と思いました。 そうすると、並べ替えは１回で済みます。
(HANA)
(みやほりん)(-_∂)b様 お返事ありがとうございます。 早速変更させていただきました。 Withの使い方がよく分からず、今まで放置してきましたが色々な例を見て勉強していきたいと思います。 Application.CutCopyMode = Falseもマクロの記録で範囲選択をいつもESCキーで消していたため そのままコピーしてしまいました。 今後は意味を調べた上で使って行きたいと思います。 ありがとうございました。
(HANA)様 お返事ありがとうございます。 最初は原料表A、Bを一つの表にまとめていたのですが、 ・HLOOKUPで参照しているセルが違うこと ・参照元のBookの名前が月ごとに変わる ・数式の変更を容易に行いたい ・コードや品名による並び替えでは原料表A、Bを区別できない の４点を検討したところ今の状態に落ち着きました。 はじめに説明しなかった非礼をお詫びします。 申し訳ございませんでした。
オートフィルタの件は非常に参考になりました。 別のBookで日付を抜き出すときに作ったコード（別のパソコンのため現時点では書き加えられない）が そのまま転用できそうです。 ありがとうございました。 （たかなし）
ん？読み違えてます？ ＞Range(Cells(2, 1), Cells(21, 3)).Select 'コード順に並び替え この部分で、結局 原材料Ａ、Ｂを区別することなく コード順に並び替えているのでは・・・？
↓の表だったら 【行数表】シート [A] [B] [C] [D] [E] [F] [G] [H] [I] [J] [1] 原料表A 原料表B [2] コード 品名 行数 数量 コード 品名 行数 数量 [3] 450020 ミント 60 500 854657 ラベル細 102 3000 [4] 450040 ナツメグ 12 100 325241 ボトルA 12 100 [5] 450010 Ａｌｃ 79 0 552453 Ｃａｐ 5 0
↓になるのですよね。 【搬送予定表】シート [B] [C] [D] [8] 325241 ボトルA 100 ←Ｂ [9] 450020 ミント 500 ←Ａ [10] 450040 ナツメグ 100 ←Ａ [11] 854657 ラベル細 3000 ←Ｂ
というか、御提示のコードを動かしたら、そうなりますが。 何処で「原料表A、Bを区別する」が絡んで来るのですか？
また、 上の３つについては、問題ないと思っていますが。。。。
(HANA)
あ・・・・ コードの読み違えではなくて コメントの読み違えですね。 ・・・たぶん。
「最初から一つの表にしておいてはどうか」 と言う提案をしたのではなく
マクロを実行したら １．整形シートのデータ削除 ２．整形シートに原材料Aのデータを値貼り付け（データのある最終行迄の範囲） ３．２の下に原材料Bのデータを値貼り付け（データのある最終行迄の範囲） ４．不要列（C列）の削除 ５．数量を降順で並べ替え ６．上から40行分に付いて0の削除 ７．この範囲をコード順に並べ替え ８．その範囲をコピーして、搬送予定表シートに貼り付け と言う流れにするのはどうか
でした。
現在は２の前に 原材料Aのデータの数量を降順で並べ替え の作業が入り、３の前に 原材料Bのデータの数量を降順で並べ替え が行われていますが、その２つをしないだけで 基本的には同じ考え方をしたつもりです。
そして、 ５の段階でコード順に並べ替えをして ６．オートフィルタの設定、0以外抽出 ７．搬送予定表シートのデータ削除 ８．整形シートの表示部分をコピーして 搬送予定表シートに貼り付け とすれば、もう一つ並べ替えが減らせます。
ちなみに、訂正されたコードの Range(Cells(4, i), Cells(24, i + 3)).Select は、このままでは Sheets(shB) に実行されてしまいますよ。
↓With のご理解が深まれば・・・。
A1セルの値を書き換えるので、複製ファイルで試してください。
Sub 確認()
Dim shA As String, shB As String
shA = "行数表"
shB = "整形"
MsgBox shB & "シートをアクティブにします。"
Sheets(shB).Select
MsgBox "Range(""A1"")に「整形シート」と書き込みます。"
Range("A1").Value = "整形シート"
With Sheets(shA)
MsgBox "．Range(""A1"")に「行数表シート」と書き込みます。"
.Range("A1").Value = "行数表シート"
MsgBox "「Range(""A1"")」の値は " & Range("A1") & vbCrLf & _
"「．Range(""A1"")」の値は " & .Range("A1") & vbCrLf & " です。"
MsgBox "「．Select」で " & .Name & " シートがアクティブになります。"
.Select
End With
End Sub
(HANA)
(HANA)様 理解が及ばず重ね重ね申し訳ありません。 確かに一度全てのデータをコピーしてしまえば並べ替えを二度繰り返す必要がないですね。 Withについてですが、コピーして試したところよりよく理解できました。 本当にありがとうございます。 まだまだ職場で変えていかなくてはならないものがたくさんあるので、指摘していただいたことを頭に頑張りたいと思います。 ありがとうございました。 （たかなし）
あとは、みやほりんさんが書いて居られますが
＞Selectメソッドと、その直後に取得されているSelectionプロパティは
＞おおむね省略することが出来ます。
これは、↓の様な所にも言えます。
Sheets(shB).Select
Cells.Select
Selection.ClearContents
単純にSelectを無くして後ろに続けると
Sheets(shB).Cells.ClearContents
の１行になりますが、これは問題なくワークすると思います。
しかも、どのシートが選択されている状態でも
shBシートに画面が切り替わることなく、shBシートの内容を
削除することが出来ます。
マクロの記録からのコードだと、どうしても ○○.Select → Selection.×× と言ったコードになってしまいますが 多くの場合、Selectしない方が処理速度が上がります。
どのようなSelectなら単純な削除でワークするか 同じ事が、他にはどの様に書けるのか。 沢山怒られながら、色々な所を消してみて下さい。
(HANA)
HANA様 早速本日いろいろ消してみたところ、いくつか動かないところがありました。 変更箇所が全域に及ぶため、最初の記事を今現在（1/26）に差し替えておきます。 いくつか動かなかった箇所は
With Sheets(shA)
.Range(.Cells(t, i), .Cells(rwA, i + 3)).Copy
End With
と
Sheets(shB).Select
Cells(2, 1).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
と
With Sheets(shF)
.Cells(8, 2).PasteSpecial Paste:=xlValues
.Select
Range(.Cells(8, 2), .Cells(27, 4)).Select
Selection.Sort Key1:=Range("B8"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
:=xlPinYin
End With
の三箇所です。
みやほりん様に教えていただいたことを頼りに、selectionを省略しようと1番目と二番目を
Sheets(shA).Range(.Cells(t, i), .Cells(rwA, i + 3)).Copy
と
With Sheets(shF)
.Cells(8, 2).PasteSpecial Paste:=xlValues
.Range(.Cells(8, 2), .Cells(27, 4)).Sort Key1:=Range("B8"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
:=xlPinYin
End With
のように直してみたのですが、コンパイルエラー 参照が一致しません。と出たり、
オブジェクトがありませんと出てしまいうまく動いてくれませんでした。
Selectを追加したり、値を変数ではなく数値にしたりとしてみましたが自分では
気づけないようですので申し訳ないのですが教えていただけないでしょうか。
また、二番目は抽出したデータのコピーをするためそのようにしたのですが、
うまく同じ結果が得られる式にできなかったのでそのままにしてしまいました。
こちらも併せて教えていただけると助かります。
図々しいお願いではございますが、今一度宜しくお願いいたします。
（たかなし）
セル番地を書くときは 「どのシートに対する物か」 意識するのが良いと思います。
最初から２番目のコードですが ＞Sheets(shF).Range(Cells(8, 2), Cells(27, 4)).ClearContents ~~~~~~~~~~~ ~~~~~~~~~~~~ この二つは、Sheets(shF)のシートのセルですので Sheets(shF).Range(Sheets(shF).Cells(8, 2), Sheets(shF).Cells(27, 4)).ClearContents と書きます。 ~~~~~~~~~~~~ ~~~~~~~~~~~~ shFが選択されている時に実行すれば最初のコードでもエラーは起きませんが 別のシートが選択されていると、エラーになります。
よく見ると（見なくてもですが・・・）「Sheets(shF)」が３回もでてくるので
Withでまとめてしまいます。
With Sheets(shF)
.Range(.Cells(8, 2), .Cells(27, 4)).ClearContents
End With
この形は、現在一番目のご質問として載せて居られる部分と同じ形に成りますね。
これを↓の様にしてしまうと（Withから出す）
＞Sheets(shA).Range(.Cells(t, i), .Cells(rwA, i + 3)).Copy
／~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~
「どのシートのセルよ！！」って怒られてしまいますよ。
二番目のご質問に関しては・・・・
アクティブでないシートのセルをSelectさせようとすると、怒られます。
それぞれ「どのシートの！！」ってエクセルに伝えながら
セレクトせずに 範囲を取得して行きましょう。
＞ Sheets(shB).Select
＞ Cells(2, 1).Select
＞ Range(Selection, Selection.End(xlDown)).Select
＞ Range(Selection, Selection.End(xlToRight)).Select
＞ Selection.Copy
範囲の最初は Sheets(shB).Cells(2, 1) のセル
最後は Sheets(shB).Cells(2, 1).End(xlDown).End(xlToRight) のセル
~shBシート~ ==A2====から~下端セル~~の====右端==== のセル
これを、Rangeの中に入れます。
Sheets(shB).Range(Sheets(shB).Cells(2, 1), Sheets(shB).Cells(2, 1).End(xlDown).End(xlToRight)).Copy
~~~~~~~~~最初~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~~最後~~~~~~~~~~~~~~~~~~~~~~~
ここもWith を使ってしまいましょう。
With Sheets(shB)
.Range(.Cells(2, 1), .Cells(2, 1).End(xlDown).End(xlToRight)).Copy
End With
三番目は惜しいことに
Key1:=Range("B8")
~~~~~~~~~~＼ここの前の「.」をお忘れです。
もしもその下の「.Cells(8, 2).Select」が必要なら これが実行されるまでに、Sheets(shF)がアクティブに成っている必要が有ります。
こんな感じの変更をしてみるのでどうでしょう。
(HANA)
HANA様
せっかくわかりやすくWithについて教えていただいたのに、 理解が及んでおらず申し訳ありませんでした。 私の中では単純に「主語を省略することができる」と解釈していました。
改めて「どのシートの！！」などの言い回しはとてもわかりやすかったです。 ありがとうございました。
感謝の言葉しか返せず申し訳ありません。 本当にありがとうございました。
（たかなし）
AdvancedFilterはあまり使わないので忘れていましたが そう言えば、直接別シートに書き出すことが出来ます。
抽出先のシート（搬送予定表）から フィルタオプションの設定をすることで 抽出先をそのシートの任意のセルに設定出来ます。
見出し行がついてきますので、 見出しが違う場合は削除。（或いは揃える） 同じ場合は、一行上に抽出しておけば 整形シートの抽出データをコピーして、貼り付け や 整形シートの非表示行を全て表示 なんて事をしなくても良くなりそうです。
まだ見て下さると良いのですが・・・。
(HANA)
HANA様
わざわざありがとうございます。 他の記事も自分の勉強のためにと思い、時間に余裕があるときにはこちらにお邪魔させていただいております。
抽出先のシートにAdvancedFilterのコードを使うと直接抽出結果を表示させることができるのですか。 参考になる記事か、マクロの記録で再現できるのであれば教えていただければと思います。 （たかなし）
こんにちは。かみちゃん です。
横から失礼します。
> 抽出先のシートにAdvancedFilterのコードを使うと直接抽出結果を表示させることができるのですか
最近、フィルタオプションの設定でデータを抽出することが多くなり、同様のことをしています。 私は、以下を参考にしてみて、勉強しました。
http://www.eurus.dti.ne.jp/~yoneyama/Excel/filter3.htm#tyusyutu
ポイントは、 HANAさんも >> 抽出先のシート（搬送予定表）から >> フィルタオプションの設定をする と書かれていますが、 別のシートに抽出する場合には、抽出先をアクティブにした状態で操作します。
(かみちゃん) 2009-01-27 23:06
おっと、かみちゃんさんからコメントがつきましたが 書きかけだったのでそのまま載せておきますね。
それは良かったです。 一つ御願いが有るのですが ご自身のスレ内でも、署名を付けて頂けませんか？ 署名を忘れて書き込みをして仕舞うことも多々有りますし 参加者が増えてくると、どれが誰の発言かわかりにくくなって仕舞いますので。
＞マクロの記録で再現できるのであれば教えていただければと思います。 と思いまして 抽出先のシート（搬送予定表）から フィルタオプションの設定をすることで 抽出先をそのシートの任意のセルに設定出来ます。 と書いてみました。
現在使って居られるコードと、少し変わります。 （設定する項目も増えます。抽出先の指定が。）
(HANA)
かみちゃん様 ご提示いただきありがとうございます。 現在ゆっくり見ることができませんので、御礼だけお先に失礼いたします。
HANA様 署名の件申し訳ありませんでした。 先ほど訂正させていただきました。 ご指摘いただきありがとうございます。
頭が回らなくてすみません。 マクロの記録も後ほど試してみます。
取り急ぎお礼までに。
ありがとうございました。
（たかなし）
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.