- ベストアンサー
エクセルデーターベース 抽出したものだけを別シートに張る方法を教えてください。
エクセルデーターベースで、職員の勤務表管理をしています。 ある条件によってF列に”○”、”△”、”×”などの記号が入力されています。 この中で”○”だけを抜出、抜き出したものをすべて別シートに貼り付けたいのです。 Selection.AutoFilter Field:=6, Criteria1:="○" Range("a1").CurrentRegion.Copy Destination:=Range("maru!a4") 本を見て、以上のようなマクロを書いてみたのですが、”maru”シートはずっと空白のままです。 どうすれば良いのでしょうか? データーを抽出する日によって、”○”の数は変わるので、セル数字を入れずにその時の最後の○表示のセルまでを、コピーするようにしたいのです。 いつもこちらに頼ってすみません。 どうぞよろしくお願いします。
- orennji1111
- お礼率31% (69/218)
- オフィス系ソフト
- 回答数4
- ありがとう数0
- みんなの回答 (4)
- 専門家の回答
質問者が選んだベストアンサー
おはようございます。 > Range("maru!a4") これはこれで大丈夫です。ただし、推奨できる書き方ではありません。 AutoFilter は使う前に、一度初期化した方が良さそうですね。ときおり、 不安定です。また、このマクロは、 「元データがあるシートをアクティブにしてから実行」 する必要があります。理由は、Selection が使われているからです。 Selection というのは、酷く曖昧です。Selection とは、マクロの実行時に ・選択していたセル(単一とは限らず複数のセル範囲であることも) ・選択していたシェープなどのオブジェクト などの様にユーザーがその時選択していたモノを表しますから、不定です。 したがって、例えば、元データのシート以外を選択中にこのマクロを実行 した場合、意図しない場所にオートフィルターが設定されてしまう可能性 があります。 これを回避するなら、オートフィルターを設定するセルを明示的に指定した コードを書くようにして下さい。こんな感じです。 Sub Sample() With ThisWorkbook.Sheets("元データのシート名").Range("A1") .AutoFilter 'オートフィルターの初期化 .AutoFilter Field:=6, Criteria1:="○" .CurrentRegion.Copy Destination:= _ ThisWorkbook.Sheets("maru").Range("A4") End With End Sub
その他の回答 (3)
- imogasi
- ベストアンサー率27% (4737/17068)
VBAをマクロというような初心者は、なぜかコピーに拘るようだが、初めは代入のコードを使うう方が良い(書式等が移らないが、移す手もある)。技量があがってからコピーを使う方法を検討すると良い。 下記は別の課題でも応用が広いはず。 Sub test01() Dim sh1 As Worksheet Dim sh2 As Worksheet Set sh1 = Worksheets("Sheet1") Set sh2 = Worksheets("Sheet2") '--- d = sh1.Range("A65536").End(xlUp).Row k = 1 For i = 1 To d If sh1.Cells(i, "F") = "○" Then sh2.Cells(k, "A") = sh1.Cells(i, "A") sh2.Cells(k, "B") = sh1.Cells(i, "B") sh2.Cells(k, "C") = sh1.Cells(i, "C") sh2.Cells(k, "D") = sh1.Cells(i, "D") sh2.Cells(k, "E") = sh1.Cells(i, "E") sh2.Cells(k, "F") = sh1.Cells(i, "F") k = k + 1 End If Next i End Sub ーーーー 解説 Set sh1 = Worksheets("Sheet1") ()内を今の基データシートのシート名に変えること Set sh2 = Worksheets("Sheet2") ()内を抜き出し後のシート名に替えること。manu? d = sh1.Range("A65536").End(xlUp).Row A列の最終行番号数を捉えている 抜き出し後シートの、抜き出しデータの記入スタート行番号 For i = 1 To d 第1行目からd行まで繰り返し。 見出し行があって、デー行が3行目から始まっていると、 For i = 3 To d If sh1.Cells(i, "F") = "○" Then 基シートのF列が○だったら sh2.Cells(k, "A") = sh1.Cells(i, "A") 基シートのA列データを抜き出しシートのA列に代入 以下同じ。列数だけ繰り返し For j = 1 To 6 sh2.Cells(k, j) = sh1.Cells(i, j) Next j とすると多列の場合コード行数が少なくて済む。 k = k + 1 抜き出し表ですぐ下の行に次に書き込む準備
- takachan7272
- ベストアンサー率29% (179/616)
最後のRange("maru!a4")のところが問題じゃないかと思います。 Destination:=Worksheets("maru").Range("A4")に書き換えて実行してみて下さい。 それでもダメなら、私が使っているコードを利用してみて下さい。 シート名と抽出条件は変えて下さいね。 Worksheets("sheet1").Range("A1").AutoFilter field:=1, Criteria1:="東京都" Worksheets("sheet1").Range("A2").CurrentRegion.Copy _ Destination:=Worksheets("sheet2").Range("A2")
- chiezo2005
- ベストアンサー率41% (634/1537)
オートフィルタを使ったほうが簡単に思います。 ○データのある一番上のひとつ上のセルを選択して, メニューのデータ→オートフィルタ でドロップダウンボックスがでますから, そこで○なら○を選択すると○の入力されている行だけの表になります。 その状態で選択して,別のシートに貼り付ければOKです。 ちょっと目的と違いますかね?
関連するQ&A
- エクセルVBA:コピーの貼り付け先
VBA初心者です。よろしくお願いします。 あるデータベースをセルB2に入力されている値で絞込み、 シート2に貼り付けるとき、下記の(1)がおそらく正解だと思いますが、 ★(質問1) (2)でも同じ結果が得られました。コピー先の目的地を示す「Destination:=」の部分は省略して全く問題なしと考えてよろしいのでしょうか? ★(質問2) (3)で試してみても同じ結果が得られました。range("sheet2!A1") なんて書き方は、たまたま、試してみたらできちゃった(同じ結果が得られた)のですが、使い方として問題ありませんか? ------------------------------------------------------------- (1) Sub test01() With Range("A1") .AutoFilter field:=2, Criteria1:=Range("B2") .CurrentRegion.Copy Destination:=Sheets("Sheet2").Range("A1") .AutoFilter End With End Sub -------------------------------------------------------------- (2) Sub test01() With Range("A1") .AutoFilter field:=2, Criteria1:=Range("B2") .CurrentRegion.Copy Sheets("Sheet2").Range("A1") .AutoFilter End With End Sub -------------------------------------------------------------- (3) Sub test01() With Range("A1") .AutoFilter field:=2, Criteria1:=Range("B2") .CurrentRegion.Copy Range("Sheet2!A1") .AutoFilter End With End Sub
- ベストアンサー
- オフィス系ソフト
- EXCEL VBA オートフィルで別シートへコピー
EXCEL VBA オートフィルで別シートへコピー しようとしたら、うまくいきません 別々に書くとうまくいくのですが コードを一緒にするとうまくいきません? コード *********************************************** Sub 抽出別シート() Worksheets("時間合計VB").Select ' 時間合計VBのシートを選択 Range("A1").AutoFilter field:=8, Criteria1:="<=1" '1時間以下の8列目のをフィルター end sub sub カレントで別シートへコピー() Range("A1").CurrentRegion.Copy Sheets("1hdown").Range("A1") 'それをカレントして別シートのA1へコピー Range("A1").AutoFilter End Sub *********************************************** このように書くとうまくいくのですが これを一緒に書くと別シートへコピーがうまくいきません。 全てコピーされてしまいます +++++++++++++++++++++++++++++++++++++++++++++++ 一緒にしたコードです +++++++++++++++++++++++++++++++++++++++++++++++ *********************************************** Sub 抽出別シート() '1h以下をを抽出別シートへコピー Worksheets("時間合計VB").Select ' 時間合計VBのシートを選択 Range("A1").AutoFilter field:=8, Criteria1:="<=1" '1時間以下の8列目のをフィルター Range("A1").CurrentRegion.Copy Sheets("1hdown").Range("A1") 'それをカレントして別シートのA1へコピー Range("A1").AutoFilter End Sub *********************************************** 意味が分かりませんどなたかおしえていただけませんでしょうか? よろしくお願いいたします
- ベストアンサー
- Excel(エクセル)
- Excelでマクロを繰り返したい。
Excelでマクロを記録したら以下のようになりました このマクロを以下の条件で繰り返したいのですが。 Sub Macro1() '------------- '----------------------- ' Sheets("Sheet1").Select Selection.AutoFilter Field:=4, Criteria1:="=5*", Operator:=xlAnd, _ Criteria2:="<>5@*" Range("A3:A302").Select Selection.Copy Sheets("Sheet2").Select Range("A3").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("Sheet1").Select Range("A1").Select Selection.AutoFilter Field:=4, Criteria1:="=6*", Operator:=xlAnd, _ Criteria2:="<>6@*" Range("A3:A302").Select Selection.Copy Sheets("Sheet2").Select Range("B3").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("Sheet1").Select Selection.AutoFilter Field:=4, Criteria1:="=7*", Operator:=xlAnd, _ Criteria2:="<>7@*" Range("A3:A302").Select Selection.Copy Sheets("Sheet2").Select Range("A103").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("Sheet1").Select Range("A1").Select Selection.AutoFilter Field:=4, Criteria1:="=8*", Operator:=xlAnd, _ Criteria2:="<>8@*" Range("A3:A302").Select Selection.Copy Sheets("Sheet2").Select Range("B103").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False End Sub 条件= Field:は4~35位まで変動します 一連の動作をコピーして手作業で数字を変えてみたのですが プロージャが大きすぎてエラーになってしまいます。 何か良い方法は無いでしょうか?。
- ベストアンサー
- オフィス系ソフト
- エクセルマクロ 抽出したデータを別のシートへコピーしたい
マクロ初心者のため、やり方が全くわかりません。 どなたか教えてください。 やりたいことは、 【1】シート名「データ」をA列でオートフィルタ抽出して、別シートにコピーする。 【2】別シートにコピーしたデータに外枠罫線をつける。 【3】シート名「データ」には塗りつぶしがあるので、別シートにコピーされた塗りつぶしは「なし」する。 【4】シート名「Sheet1」の1~2行目をコピーし、別シートの1~2行目に挿入し、シート名「データ」に戻る。 コピーするシートはあらかじめ作成しています。 簡素化の方法がわからないので、 とりあえず自分で作ってみたものが下にあるものです。 繰り返す方法がわからないので、今はコピーして「あ行」の部分を書き換えています。(かなり面倒です) 最終的には、抽出されたそれぞれのシートを別々のブックにしたいとも思っています。 長々とすみませんが、どなたか教えてください。 よろしくお願いします。 以下、作成したマクロです。 Sheets("データ").Select Range("A1").Select Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select Selection.AutoFilter Selection.AutoFilter Field:=1, Criteria1:="あ行", Operator:=xlAnd Range("A1").Select Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select Selection.Copy Sheets("あ行").Select Range("A1").Select ActiveSheet.Paste Range("A1").Select Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlMedium .ColorIndex = xlAutomatic End With Cells.Select Selection.Interior.ColorIndex = xlNone Sheets("Sheet1").Select Rows("1:2").Select Selection.Copy Sheets("あ行").Activate Rows("1:1").Select Selection.Insert Shift:=xlDown Range("A1").Select Sheets("データ").Select Range("A1").Select
- ベストアンサー
- オフィス系ソフト
- 違う列で、2つの抽出条件を満たすには
OSはXPで、Excel2003を使用しています。 下記のマクロですと、Key列に任意の文字があって、Key2列に任意の文字が入っていなくても抽出されますが、 その逆、Key列に任意の文字がなくて、Key2列に任意の文字が入っている場合は抽出されません。 前者の場合も、後者の場合も抽出される様にするには、どの様にすれば良いか教えて下さい。 ***** Sub test() Dim Key As String Dim Key2 As String Key = Application.InputBox("抽出列の番号を入れて下さい") Key2 = Application.InputBox("抽出列の番号を入れて下さい") Worksheets.add After:=ActiveSheet, Count:=1 ActiveSheet.Name = "BBBB" Sheets("AAAA").Activate Range("A1").Select Selection.AutoFilter Selection.AutoFilter Field:=Key, Criteria1:="*" Selection.AutoFilter Field:=Key2, Criteria1:="*" Selection.CurrentRegion.Copy Sheets("BBBB").Activate Range("A1").PasteSpecial Paste:=xlAll Selection.CurrentRegion.Select End Sub ******* 説明不足な所がございましたら追記致します。 何卒よろしくお願い致します。
- ベストアンサー
- オフィス系ソフト
- Excelマクロで他シートへの抽出:エラー
こちらの質問 http://okwave.jp/qa/q4760155.html を参考に、エクセルマクロを作りました。 Sheet1の10列目(J)に@が入っている行をすべて、 Sheet2に抽出表示します。コードは次になります。 Private Sub Worksheet_Activate() With Sheets("Sheet1") .AutoFilterMode = False .Range("A1:N1").AutoFilter .Range("A1:N1").AutoFilter Field:=10, Criteria1:="@" .Range(.Range("A1"), .Range("A1").SpecialCells(xlLastCell)).SpecialCells(xlCellTypeVisible).Copy Range("A1") .AutoFilterMode = False End With End Sub このマクロを実行すると、確かにSheet2では抽出が行われるのですが、 同時にSheet1の内容も抽出された内容に変わってしまいます。 どこに問題があるのでしょうか。 よろしくお願いします。
- ベストアンサー
- Visual Basic
- excelで複数条件で抽出する
excel VBAで質問です。(初心者レベルです) A列からZ列までデータがあり、オートフィルタでE列で条件に当てはまるものと、E列では条件外だが、Y列では条件に当てはまるものを別シートに抽出したいと思っています。 Sub Macro1() With Worksheets("Sheet1") .Range("A1").AutoFilter _ Field:=5, Criteria1:="*条件*" .Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy _ Worksheets("Sheet2").Range("A1") End With End Sub Fieldを変えて、E列、Y列それぞれはできるのですが、データが重複してしまいます。 重複分を削除するため、セル入力で連番を降って、重複するものを削除しようとしましたがうまくいかず。 なにかいい方法はないでしょうか。
- ベストアンサー
- オフィス系ソフト
- オートフィルタ抽出データをコピーするマクロについて
マクロについて勉強中の者です。 "Sheet1"にあるデータをオートフィルタで抽出し、 "Sheet2"に抽出データのみをコピーをしたいと思っています。 Range("A10:G59").Select Selection.ClearContents With Worksheets("Sheet1").Range("A1") .AutoFilter .AutoFilter Field:=1, Criteria1:="○" .CurrentRegion.SpecialCells(xlCellTypeVisible).Copy Worksheets("Sheet2").Range("A9") End With End Sub としてみたのですが、 これを実行すると、オートフィルタが1行目(A1)ではなく、 2行目で設定されてしまい、抽出データがずれてしまいます。 A B C 1 品 名 仕入先 発注数 ←タイトル行に設定したい 2 りんご ヤマト 10 ← この行に▼が設定される 色々調べた結果のマクロなので、どこが悪いのか見当がつきません。 解りやすく教えていただける方がおられましたら、よろしくお願い致します m(__)m
- ベストアンサー
- オフィス系ソフト
- VBAでオートフィルタを使った抽出がうまくいきませんのでどなたか教えて
VBAでオートフィルタを使った抽出がうまくいきませんのでどなたか教えてください。 A列、C列に日付が入っていて、A列は空白以外のセルを表示し、かつC列は、開始日、終了日で抽出したいのですが、うまくいきません。 With Worksheets("sheet").Activate 開始日 = ">=" & TextBox1.Text 終了日 = "<=" & TextBox2.Text .Range("A1:N200").AutoFilter Field:=1, Criteria1:="<>" .Range("A1:N200").AutoFilter Field:=3, _ Criteria1:=開始日, Operator:=xlAnd, _ Criteria2:=終了日
- ベストアンサー
- その他MS Office製品
- excel 文字抽出マクロの編集についてですが・・・
マクロで指定した文字を含むデータを抽出するマクロを 作っていたのですが、うまく作動しません。 どこが悪いか教えてください。 Sub 指定した文字データの抽出() Dim strMoji As String strMoji = InputBox("検索文字を入力してください") strMoji = "*" & strMoji & "*" Sheets("Sheet2").Activate Cells.Clear With Sheets("Sheet1") .Range("A2").AutoFilter Filde:=3, criterial:=strMoji .Range("A2").CurrentRegion.Copy _ Destination:=Sheets("Sheet2").Range("A2") .Range("A2").AutoFilter End With Sheets("Sheet2").Columns("A:D").AutoFit End Sub
- 締切済み
- オフィス系ソフト