No.4ベストアンサー
- 回答日時:
こんにちは。
.AutoFilter.Rangeを使っても良いかもしれません。
また、抽出対象がない時、見出し行を含まずコピーすると、
非表示データ全部がコピーされてしまいますから、気をつけたほうが良いと思います。
With ActiveSheet
If .AutoFilterMode Then
With .AutoFilter.Range
If WorksheetFunction.Subtotal(3, .Columns(1)) > 1 Then
Intersect(.Cells, .Offset(1)).Copy _
Destination:=Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Offset(1)
End If
End With
End If
End With
pauNedさん。試してみたらばっちりで
早速使わせていただきます。ありがとうございました。
対象0件パターンもSubtotalでひっかけられました。
Intersectは、「こんなのどんな時に使えるの?」って思うくらいのすごいマニアックな関数ですね。
オートフィルタは、表示する分にはすごく便利ですが
そのデータを使おうとすると見えない行に邪魔されますね。
今回始めて使うにあたって全然わからなかったです。
またわからないことがあったらよろしくお願いします。
No.8
- 回答日時:
ka_na_deです。
質問者さん以外にコメントすることは極力控えているのですが、
Wendy02さんの回答を拝見して、どうしてもコメントしたくなりました。
すごいです。
見ればみるほど雲が晴れていきます。
なるほどー。こう書くのかー。
遊びでEXCELをいじり始めて2ヶ月ですが、
本当に奥が深いですね。
自分もこんな風にすっきり書きたいのですが、
まだまだ未熟なせいでエラーと格闘しながら
対処療法で記述しているのが現状です。
これからも、勉強させてください。
ありがとうございました。
(rex9200さん 横道にそれてごめんなさいね。)
この回答への補足
いえいえどういたしまして。
私も仕事で必要にせまられて春から始めましたが
VBAの豊富な機能には驚くばかりです。
基本から勉強ではなく必要な部分をテキストから
見よう見まねで取り込んでいるので試行錯誤の連続ですが、
会社のエクセルはヘルプファイルが無いのでとても困ります。
そういう時はつい慣れたCOBOLチックなコーディングで
逃げているのできっと効率の悪いVBAだろうと思ってます。
(この前セル操作を定番のコードと比較したら4割位遅かったですね)
でも目検では絶対出来ないチェックや手作業では嫌になるような大量作業がオートで動くさまは気持ちいいですね。
またよろしくお願いします。
ka_na_deさん、Wendy02さんへ。
ポイントがあと一人しかお付けできない為
今回お二人とも無しとさせて頂きました。
ごめんなさい。
お二人のていねいな回答に感謝しておりますので
今後ともよろしくお願いします。
No.7
- 回答日時:
こんばんは。
すでに、回答は出ていますが、私の書いたポイントをまとめておきます。
Dim r As Range
Dim Dest As Range
Set Dest = Worksheets("Sheet2").Range("A1") '貼り付け先
With Worksheets("Sheet1") 'オートフィルタのあるシート
.Range("A1").AutoFilter Field:=2, Criteria1:="PC" '検索値
Set r = .AutoFilter.Range
If IsEmpty(Dest) Then r.Rows(1).Copy Dest 'タイトルコピー
'ここで、Visible のセルをカウントする
If r.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
'これで見えるものだけのコピーは出来る
r.Offset(1).Resize(r.Rows.Count - 1).Copy _
Dest.Parent.Range("A65536").End(xlUp).Offset(1)
End If
End With
Set r = Nothing
Set Dest = Nothing
Wendy02さん、いつもありがとうございます。
Wendy02さんのコードは、私のように本のサンプルしか
しらない素人には最初はとっつきにくい(失礼)ですが
No.1の方が書かれているように、とても勉強になります。
今後ともよろしくご教授ください。
No.6
- 回答日時:
#1です。
No1の回答で選択後に手動でコピー&ペーストができたので、
tbl.Rows.Countの値を使わずにコピーしていくマクロを作ってみました。
本来は他の回答者さんのようにきちんと選択しないといけないのでしょうが・・・
難しかったので、場当たり的に作ってしまいました。ご参考までに。
Sheet1に表があって、2列目をPC,aaa,bbb,cccの項目で抽出して
空白シートのSheet2へ並べていく例です。
Sub test()
Dim ITEM
Dim i As Integer
'抽出する項目
ITEM = Array("PC", "aaa", "bbb", "ccc")
'Sheet1の見出し行をSheet2へコピー
Worksheets("Sheet1").Rows("1:1").Copy _
Destination:=Worksheets("Sheet2").Rows("1:1")
'Sheet1の表の2列目で項目を抽出後、Sheet2のデータ末尾にコピー
For i = LBound(ITEM) To UBound(ITEM)
Call filter_copy("Sheet1", 2, ITEM(i), "Sheet2")
Next i
End Sub
Public Function filter_copy(Sheet_1 As String, field_NO As Integer, _
name As Variant, Sheet_2 As String)
Dim tbl As Object
Worksheets(Sheet_1).Select
Range("A1").AutoFilter Field:=field_NO, Criteria1:=name
Range("A1").Select
Set tbl = ActiveCell.CurrentRegion
tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, tbl.Columns.Count).Select
Selection.Copy _
Destination:=Worksheets(Sheet_2).Cells(65536, "A").End(xlUp).Offset(1, 0)
End Function
No.5
- 回答日時:
おはようございます。
エラーは一旦解決されたようですね。
#1のマクロ実行後、手動でコピー&ペーストして
問題なかったので、これでよしと回答してしまいました。
選択後に、次の処理でtbl.Rows.Countの値を使って、
余計な行が張り付いたのでしょうね。
だとすると、Wendy02が回答しているように、
SpecialCells で、xlCelltypeVisible の条件でカウントする必要があると思います。
なお、pauNedさんの回答のIntersectは初めて知りました。
勉強になります。これから調べてみようと思います。
尚、すべて解決された折は、最終形を公開していただけたら幸いです。
勉強させていただきたいので、よろしくお願いします
No.3
- 回答日時:
こんばんは。
横からすみません。
tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, tbl.Columns.Count).Select
仮に、
tbl.Rows.Count - 1
↑
ここが、1 になることはありえませんが、仮に、ここが、1でも、Resizeには、-1 にならなければ、そのような、「実行時エラー」は出ません。エラーの原因は、大方、別のシートモジュールに書いているせいではないでしょうか?正しいシートモジュールか、標準モジュールに貼り付けているのでしょうか?なお、行数を取るのでしたら、SpecialCells で、xlCelltypeVisible の列ひとつのセルを数えるのだとは思います。
アドバイスありがとうございます。
Range("A1").CurrentRegion.Selectをコメント化していました。
普通はSet tbl = ActiveCell.CurrentRegionのコードだけで
表がtblにセットされるので不要と思いカットしていましたが
戻したらエラーは出なくなりました。
ただ対象があってもなくても、tbl.Rows.Countには全件数が入って
おり、かつ対象が0の時はすべての行が貼り付いてしまいました。
対象有無の判断として行数カウントを入れて見ます。
No.2
- 回答日時:
tbl.Rows.Count =1
になっているということは、見出し行しか存在せず、
データがまだ入力されていないということでしょうか?
もし、そのような場合が存在するのなら、
以下でどうですか?
もちろんデータが無いのでリサイズしません。(見出しのみ選択)
Sub test()
Range("a1").AutoFilter Field:=2, Criteria1:="PC"
Range("A1").CurrentRegion.Select
Set tbl = ActiveCell.CurrentRegion
If tbl.Rows.Count = 1 Then Exit Sub
tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, tbl.Columns.Count).Select
End Sub
追加回答ありがとうございます。
Range("A1").CurrentRegion.Selectをコメント化していました。
普通はSet tbl = ActiveCell.CurrentRegionのコードだけで
表がtblにセットされるので不要と思いカットしていましたが
戻したらエラーは出なくなりました。
ただ対象があってもなくても、tbl.Rows.Countには全件数が入って
おり、かつ対象が0の時はすべての行が貼り付いてしまいました。
No.1
- 回答日時:
これでどうですか?
Sub test()
Range("a1").AutoFilter Field:=2, Criteria1:="PC"
Range("A1").CurrentRegion.Select
Set tbl = ActiveCell.CurrentRegion
tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, tbl.Columns.Count).Select
End Sub
コードはヘルプから抜粋しました。
この回答への補足
回答ありがとうございます。
試すと「実行時エラー 1004」となってしまいました。
tbl.Rows.Countの値が何故か1になっています。
行数が1-1で0となった為だと思われます。
一旦、どこかに貼り付けてからResizeするしか
方法が無いのでしょうか。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) エクセルVBAコピー 2 2022/06/08 21:45
- Visual Basic(VBA) エクセルのマクロで対象ごとにシート分けしてその内容をセルに書き込みたい 9 2022/08/24 13:23
- Visual Basic(VBA) エクセル VBA 処理スピードを上げたいのですが。 6 2023/03/31 20:52
- Visual Basic(VBA) データのある範囲を選択するVBAについて 2 2022/09/03 00:20
- Visual Basic(VBA) excelVBAについて。 1 2022/11/30 06:16
- Excel(エクセル) VBAのoffsetの動き方について教えてください 3 2022/11/25 23:36
- Visual Basic(VBA) 【至急】Excel 同一人物の情報を一行にまとめる(複数行) 6 2022/05/24 17:58
- Excel(エクセル) エクセルのマクロでコピー後の貼り付け先を毎回指定したところにしたい 5 2022/08/12 10:47
- Visual Basic(VBA) いつもお世話になります 下記のコード実行すると エラーになります わかるかた教えてくれませんでしょう 6 2022/12/17 15:01
- Excel(エクセル) ExcelVBAについて。 2 2022/12/10 20:08
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
sqlplusの処理が途中でとまる
-
[Access]時間帯の重複チェック
-
SELECTで1件のみ取得するには?
-
Date型にNULLをセットしたい V...
-
ORDER BY 半角カナ
-
SQL>UPDATEと同時にその件数を...
-
oracleのinsert select性能
-
Oracleでの文字列連結サイズの上限
-
GROUP BYを行った後に結合した...
-
select句副問い合わせ 値の個...
-
OracleのSQL*PLUSで、デー...
-
GROUP BYを使ったSELECT文の総...
-
ファイル書込みで一行もしくは...
-
Accessで別テーブルの値をフォ...
-
キーが同じを複数行を1行にま...
-
サブフォームに新規レコードを...
-
Excelでセルの書式設定を使用し...
-
SELECTの結果で同一行を複数回...
-
DataGridViewにてセル以外をク...
-
サブレンジ分割されたNDB(富士...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
SELECTで1件のみ取得するには?
-
Date型にNULLをセットしたい V...
-
SQL>UPDATEと同時にその件数を...
-
oracleのinsert select性能
-
sqlplusの処理が途中でとまる
-
ACCESSのSQLの書き方
-
異なるDB間でのJOINやVIEWについて
-
プロシージャで変数をテーブル...
-
SELECTでの指定行からの指定行...
-
ORDER BY 半角カナ
-
AccessVBAでリンクテーブルの参...
-
☆☆☆☆SQL Olacle 3つ以上の文字...
-
ACCESSとORACLEで抽出結果が異なる
-
PostgreSQLで小数点以下を処理...
-
オラクル オブジェクトのデー...
-
正規化?の戻しについて
-
取得するデータの件数指定、MyS...
-
SQLで抽出可能でしょうか?
-
GROUP BYを行った後に結合した...
-
Accessで別テーブルの値をフォ...
おすすめ情報