[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『オートフィルタについて』（ノッポ）
マクロでオートフィルタを実施し摘出されたデータを他のシートにコピー貼り付けする方法がありますか？
下記方法だとエラーとなります。
Sheets("AAAA").Select
Selection.AutoFilter Field:=2, Criteria1:=("123456")
Range("E1:E1000").Select →ここでエラーが出ます。
Selection.Copy
Sheets("BBBB").Select
Range("P3").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
True, Transpose:=False
エラーにならない方法を教えてください。
エラーということは、エラーメッセージが出ているということでしょうか？ それとも、意図した動きになっていないということでしょうか？ 後者だとすれば、自動記録をされているようですので、「ジャンプ」から可視セルを選ぶように記録してみればいかがでしょうか？ (ROUGE)
ジャンプから選ぶようにしても無理でした。
下記のマクロは自動記憶のときはできるのですが、
実際マクロを実行させたときに2行目のRANGE（～～～～で
｢RangeクラスのSelectメソッドが失敗しました｣とメッセージがでます。
とにかく、オートフィルタで抽出したある列のデータのみを
別シートにコピー貼り付けしたいのです。
今一度、良い方法を教えて下さい。 （ノッポ）
Sheets("AA伝票").Select
Selection.AutoFilter Field:=6, Criteria1:="123456"
Range("F:F,H:I").Select
Selection.Copy
Sheets("BB在庫").Select
Range("N3").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
下記ではRangeオブジェクトが指定されていません。
オートフィルタを設定したいRangeを指定してみてはいかがですか？
> Sheets("AA伝票").Select
> Selection.AutoFilter Field:=6, Criteria1:="123456"
(ROUGE)
｢ROUGE｣様
御回答ありがとうございます。
理解できなくて申し訳ございませんが
Rangeオブジェクトが指定されていませんとは、
どういう意味ですか？
先にRangeで指定してオートフィルタをしなければならないということですか？
上記のマクロはオートフィルタをしてそれからRangeで指定する順序ですが･･･
これがダメなのですか？ （ノッポ）
Sheets("AA伝票").Range("A1").Select
~~~~~~~~~~~~例えばA1を選択する。3行目だったらA3とか。
Selection.AutoFilter Field:=6, Criteria1:="123456"
もし、自動記録の時にアクティブセルがA1だったのであれば、省略されています。
あとでそのマクロを実施したとき、アクティブセルが違うところにあったら、エラーになってしまうのです。
(ROUGE)
ヘルプより抜粋 AutoFilter メソッド expression.AutoFilter(Field, Criteria1, Operator, Criteria2) expression 必ず指定します。対象となる Range オブジェクトを表すオブジェクト式を指定します。 とあります。 ワークシートオブジェクトではありません。 (ROUGE)
下記のようなことをしたく書き込みし｢ROUGE｣様に
教えていただいているのですがどうしてもうまくいきません。
実際にマクロで実施したい内容を下記します。
①下記シート2のようなデータがあります。
シート2
列A～列D 列E 列F 列G 列H 列I
1行 № 番号 日付 数量
2行 3432 SA 060403 2254
3行 3587 DE 060412 147
4行 4152 HY 060422 2541
5行 5666 GA 060403 2620
6行 5667 GA 060327 1641
7行 5775 RF 060418 2287
8行 5846 EW 060425 500
9行 5904 GA 060417 5040
10行 6005 SA 060422 630
11行 6179 GA 060410 3752
12行 6339 KO 060501 100
13行 6412 EW 060418 5000
14行 6542 GA 060420 180
15行 6675 EW 060330 2100
16行 6953 LO 060426 75
・ ・ ・ ・ ・
・ ・ ・ ・ ・
・ ・ ・ ・ ・
・ ・ ・ ・ ・
※最大2000行になります。
②列Fをオートフィルタで｢GA｣を選択し下記のようにします。
シート2
列A～列D 列E 列F 列G 列H 列I
1行 № 番号 日付 数量
5行 5666 GA 060403 2620
6行 5667 GA 060327 1641
9行 5904 GA 060417 5040
11行 6179 GA 060410 3752
14行 6542 GA 060420 180
③下記のようにシート1にオートフィルタしたデータをコピー貼り付けする。
シート1
列A～列M 列N 列O 列P
1行
2行
3行 № 日付 数量
4行 5666 060403 2620
5行 5667 060327 1641
6行 5904 060417 5040
7行 6179 060410 3752
8行 6542 060420 180
私はオートフィルタで考えてますが、別のやり方があればそれでも可です。
宜しくお願い致します。 （ノッポ）
何がうまくいかないのかが分からないので、解決方法も分からないのです・・・orz
ちなみに、
> Range("F:F,H:I").Select
を
Range("F:F,H:I").SpecialCells(xlVisible).Select
にしてもだめですか？
(ROUGE)
Range("F:F,H:I").SpecialCells(xlVisible).Select
でもだめでした。ROUGEさんでしたらどのようにマクロを組みますか？
基本的にシロウトで、自動記憶でしか作成できません。
宜しくお願い致します。 （ノッポ）
ほならまあフィルター無しのマクロでやってみまひょか。
あくまでマージセルが無いという条件で
これはSheet2のK1に書かれたデータで拾うようにでけとりますから、K1にそのデータを
書き込んでおくんなはれ。
（弥太郎）
'------------------
Sub noppo()
Dim dic As Object
Dim i As Long
Dim tbl
With Sheets("sheet2")
Set dic = CreateObject("scripting.dictionary")
tbl = .Range("e2").Resize(.Range("e65536").End(xlUp).Row - 1, 5).Value
For i = 1 To UBound(tbl, 1)
If tbl(i, 2) = .Range("k1") Then
dic(tbl(i, 1)) = Array(tbl(i, 2), tbl(i, 5))
End If
Next i
End With
With Sheets("sheet1")
.Range("n4:p65536").ClearContents
If dic.Count > 0 Then
.Range("n4").Resize(dic.Count) = Application.Transpose(dic.keys)
.Range("o4").Resize(dic.Count, 2) = Application.Transpose(Application.Transpose(dic.items))
End If
End With
Set dic = Nothing
End Sub
Selectメソッドが失敗する、ということから、記録したマクロコードを コマンドボタンクリックイベントのプロシージャに貼り付けて実行しているのでは ないかと推測しますが、ちがいますか。 (みやほりん)(-_∂)b
おっと、事務所移転で肉体労働している間にししょ～とみやほりんさんからレスがついてた。
σ(^-^;)はまだでくしょなり～のすきるはないので、別の方法でやってみますた。
ししょ～のコードに比べると時間ははるかに多くかかってしまいますが、こんなんもあるということで・・・
同じく、シート2のK1に条件を入れてください。
'----
Sub ごん太()
Dim midashi() As String
Dim i As Long
midashi = Split("No.,日付,数量", ",")
With Worksheets("Sheet1")
.Range("N3:P" & Rows.Count).ClearContents
.Range("N3:P3") = midashi
If Worksheets("Sheet2").Range("K1").Value = "" Then: MsgBox ("条件がおまへん"): Exit Sub
For i = 2 To Worksheets("Sheet2").Range("F" & Rows.Count).End(xlUp).Row
If Worksheets("Sheet2").Cells(i, 6).Value = Worksheets("Sheet2").Range("K1").Value Then
.Range("N" & Rows.Count).End(xlUp).Offset(1).Value = Worksheets("Sheet2").Cells(i, 5).Value
.Range("O" & Rows.Count).End(xlUp).Offset(1).Value = Worksheets("Sheet2").Cells(i, 8).Value
.Range("P" & Rows.Count).End(xlUp).Offset(1).Value = Worksheets("Sheet2").Cells(i, 9).Value
End If
Next
End With
End Sub
'(ROUGE)
オートフィルタを使えば、こんな感じでしょうか・・・
この前の使い回しですが・・・(Hatch@Excel2002)
Sub Macro15()
Dim lRow As Long
Application.ScreenUpdating = False
'---コピー先をクリア
lRow = Worksheets("Sheet1").Range("N50000").End(xlUp).Row
Worksheets("Sheet1").Range("N3:P" & lRow).Clear
'---オートフィルタ
lRow = Worksheets("Sheet2").Range("F50000").End(xlUp).Row
Worksheets("Sheet2").Range("E1:I" & lRow).AutoFilter Field:=2, _
Criteria1:="GA" '--抽出条件=Worksheets("Sheet2").Range("K1").Value
'---可視セルのコピー&貼り付け
Worksheets("Sheet2").Range("E1:E" & lRow).SpecialCells(xlCellTypeVisible).Copy _
Worksheets("Sheet1").Range("N3")
Worksheets("Sheet2").Range("H1:I" & lRow).SpecialCells(xlCellTypeVisible).Copy _
Worksheets("Sheet1").Range("O3")
'---オートフィルタをOFF
Worksheets("Sheet2").Range("E1:I" & lRow).AutoFilter
Application.ScreenUpdating = True
End Sub
みなさま
できました！ありがとうございました！（ノッポ）
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.