- ベストアンサー
VBAにて特定文字(セル)抽出
例 Sheet2 (E列) (F列) 3 41 兵庫高速道路 33333 42 阪神高速道路 55555 52 63 64 阪神高速道路 66666 Sheet2のE41からデータのある所(約200)までの決まった文字「阪神高速道路」とその隣(F列)のセットセルを抽出し、Sheet3のF3へ順にコピーしたいと思います。 *Sheet2のE41以降は空白ありません。 結果 Sheet3 (F列) (G列) 3 阪神高速道路 55555 4 阪神高速道路 66666 5 6 7 となるように。 Dim Cr As Range With Sheets(2) Set Cr = .Range("E1:F1") Cr.Item(1).Formula = "=E41" Cr.Item(2).Value = "'=阪神高速道路" .Range("E41").CurrentRegion.AdvancedFilter _ xlFilterCopy, _ CriteriaRange:=Cr, _ CopyToRange:=Sheets(3).Range("F3") End With うまく抽出できません。お願い致します。
- みんなの回答 (3)
- 専門家の回答
質問者が選んだベストアンサー
関連するQ&A
- ExcelのVBAでの抽出
初心者です。よろしくお願いいたします。 sheet1の"A2"~"C6"に簡単な表を作りました。 A列に人の名前が入力されています。 そこで、A列の名前が"花子"のデータだけを抽出 してSheet2へコピーしたいのです。 そこで試行錯誤の上、下のような記述をしました。 Sub 抽出() Application.ScreenUpdating = False Sheets("sheet2").Activate Sheets("sheet2").Columns("A:C").Clear With Sheets("Sheet1") .Range("A2").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:="花子", CopyToRange:=Sheets("sheet1").Range("A2"), Unique:=False End With Application.ScreenUpdating = True End Sub しかし、うまくいきません(TT) エラー:400 とかでるんですけど なにがいけなんでしょうか・・。 他にもAdvancedFilterを使うさいに気をつけること がありましたらご指導ください。 (項目行の中のセルが統合されていたりすると うまくいかない・・・とかあるんでしょうか。) よろしくご指導ください。お願いいたします。
- ベストアンサー
- オフィス系ソフト
- excel マクロでデータ抽出したい
excelの抽出をマクロ化しようと思っています。 キー記録で Sheets("data").Range("B11:O714").AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Sheets("data").Range("G3:G5"), CopyToRange:=_ Range("B4:O615") , Unique:=False を得たので、これを元にして、条件範囲をオートシェイプのある列を条件にしようと思い、 col = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Column で、オートシェイプの列を取得し、 Sheets("data").Range("B11:O714").AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Sheets("data").Range(Cells(3, col), Cells(5, col)),_ CopyToRange:=Range("B4:O615") , Unique:=False としたのですが、エラーになってしまいます。 colを使って条件範囲をするにはどうしたらいいのでしょうか? よろしくお願いします。
- ベストアンサー
- Visual Basic
- VBAでエラー時にメッセージを表示したい
こんばんわ! エクセルのVBAについて質問です。 以下のように組み込みDATAシートからフィルターをかけて抽出シートへ結果を表示するようになっていますが、DATAシートにデーターがない状態でするとエラーになりますがその際にDATAシートにデーターが入っていませんとメッセージボックスが出る様にするにはどうすればいいでしょうか? まだまだ勉強中の身ですので教えて頂ければ有難いです。 お手数ですが宜しくお願いします。 Sub 抽出() Application.ScreenUpdating = False Sheets("抽出").Activate Cells.Clear Sheets("抽出").Range("A1").Value = Sheets("DATA").Range("A2").Value Sheets("抽出").Range("B1").Value = Sheets("DATA").Range("B2").Value Sheets("抽出").Range("C1").Value = Sheets("DATA").Range("C2").Value Sheets("抽出").Range("D1").Value = Sheets("DATA").Range("D2").Value Sheets("DATA").Range("A3").CurrentRegion.AdvancedFilter _ Action:=xlFilterCopy, _ CriteriaRange:=Sheets("検索").Range("A1:D2"), _ CopyToRange:=Sheets("抽出").Range("A1"), _ Unique:=False Sheets("抽出").Columns("A:D").AutoFit Application.ScreenUpdating = True End Sub
- ベストアンサー
- Visual Basic
- エクセル2007 VBAについて教えてください。
顧客情報と販売履歴をソフトからCSVで書き出してシート1とシート2へ貼り付けしてそのデータをシート3へ抽出しているのですが、もっと良い方法があれば教えてください。 顧客情報と販売履歴がソフト上の関係で別々に書き出しされる為、シート1へ顧客情報のみを貼り付けしております。シート2に販売履歴を貼り付けしております。 そのデータを別シート A納品番号 B代引金額 C略称 D客先名 E郵便番号 F住所1 G住所2 H.TEL K納品番号(A列と同じコードです)L伝票No M管理番号 N客先情報 O商品コードP商品名Q数量 R納入単価 S納入金額 T客先コード変換 U商品名半角 へ転記するようにしております。 ここで抽出ボタン(マクロ起動)すると161行目から抽出するようにしております。 Private Sub CommandButton3_Click() Range("K161").Select Range("K1:U149").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _ "A161:A162"), CopyToRange:=Range("K161"), Unique:=False ActiveWindow.SmallScroll Down:=9 Range("K167").Select Range("K1:U149").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _ "A167:A168"), CopyToRange:=Range("K167"), Unique:=False ActiveWindow.SmallScroll Down:=9 Range("K173").Select Range("K1:U149").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _ "A173:A174"), CopyToRange:=Range("K173"), Unique:=False ActiveWindow.SmallScroll Down:=6 Range("K179").Select Range("K1:U149").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _ "A179:A180"), CopyToRange:=Range("K179"), Unique:=False ActiveWindow.SmallScroll Down:=9 Range("K185").Select Range("K1:U149").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _ "A185:A186"), CopyToRange:=Range("K185"), Unique:=False Range("K191").Select Range("K1:U149").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _ "A191:A192"), CopyToRange:=Range("K191"), Unique:=False ActiveWindow.SmallScroll Down:=6 Range("K197").Select Range("K1:U149").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _ "A197:A198"), CopyToRange:=Range("K197"), Unique:=False ActiveWindow.SmallScroll Down:=6 Range("K203").Select Range("K1:U149").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _ "A203:A204"), CopyToRange:=Range("K203"), Unique:=False Range("K210").Select Range("K1:U149").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _ "A210:A211"), CopyToRange:=Range("K210"), Unique:=False ActiveWindow.SmallScroll Down:=9 Range("K216").Select Range("K1:U149").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _ "A216:A217"), CopyToRange:=Range("K216"), Unique:=False Range("K222").Select Range("K1:U149").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _ "A222:A223"), CopyToRange:=Range("K222"), Unique:=False そしてこのデータを転送用と言うシート A3納品番号 B3商品名1 C3商品名2 D3商品名3 E3氏名 F3郵便番号 G3住所1 H3住所2 I3住所3 J3名前2 K3電話番号 R3代引き金額 へ書き出ししているのですが、もう少し処理が早く出来る提案はありますでしょうか? 問題なく動いてはいるのですが、少し処理に時間がかかってしまう為、簡単な方法があるかご質問させて頂きました。 皆様の知恵をお貸しください。
- ベストアンサー
- Visual Basic
- ExcelVBAで、必要な列を抽出する方法
いつもお世話になっております Excelシートで、次のような表を作っています [Sheet1] A/B/C/D/E センター/氏名/生年月日/契約開始日/契約終了日 ※契約終了日のセルには計算式が入っていて、契約開始から18か月後の日付が出るようにしています。 また、G1セルに「契約終了月」、G2に「18」と入っています そこで、[Sheet2]に必要な行のみを抽出し、印刷するまでをしたいのですが、どのようにしたら良いのかわかりません 今できているのは、こんな感じです Private Sub CommandButton1_Click() Worksheets("Sheet2").Select Worksheets("Sheet2").Range("A:E").Clear With Worksheets("Sheet1") .Range("A:E").Copy Worksheets("Sheet2").Range("A1") .Range("A:E").AdvancedFilter _ Action:=xlFilterCopy, _ criteriarange:=.Range("G1:G2"), _ CopyToRange:=Worksheets("Sheet2").Range("A:F"), _ unique:=False End With If Application.CountA(Worksheets("Sheet2").Range("A:A")) > 1 Then MsgBox "今月末で契約終了です", vbOKOnly + vbInformation, "確認" If MsgBox("印刷しますか?", vbYesNo + vbQuestion, "印刷") = vbYes Then Worksheets("Sheet2").PrintOut End If Else MsgBox "今月で契約終了となる方はいません", vbOKOnly + vbInformation, "確認" End If Sheets("top_page").Select Range("A1").Select End Sub ※top_pageシートでコマンドボタンをクリックするとマクロ実行できるようにしています 連続する列の抽出の仕方はわかるのですが、例えば A列、B列、E列のみ を抽出させる場合どのようにしたらよいのか、アドバイスをお願いします できたら、抽出後、印刷までできるようなやり方がもっと簡単なのがあれば、教えていただけると助かります 色々勉強してはいるのですが、今一つわからないので、よろしくお願いします
- ベストアンサー
- Visual Basic
- オートフィルタからの選択部分のみからの抽出
オートフィルタからある特定項目のみ表示して、その特定項目からのみデータを抽出したいのですがうまくいきません。 シートAAAAにある定常にオートフィルタをかけその定常部分のみから A1:B1の内容を抽出してセルBBBBにはり付けしたいという内容です。 Sheets("AAAA").Select With Worksheets("AAAA") .Range("B5").AutoFilter _ Field:=12, Criteria1:="定常" End With Sheets("BBBB").Select Sheets("AAAA").Range("B5:O15000").AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Range("A1:B2"), CopyToRange:=Range("B7"), Unique:=True Range("B7").Select Selection.Sort Key1:=Range("B7"), Order1:=xlAscending, Header:=xlGuess, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _ :=xlPinYin 宜しくお願いします。
- ベストアンサー
- Visual Basic
- エクセル2003 条件抽出したデータを切り取り別シートへ貼り付け
シート1にあるデータから3個のキーワードで抽出したデータを切り取り、シート2に貼り付ける方法を教えてください。 今までは抽出する条件のキーワードが2個以下だったので、オートフィルタのオプションで抽出したデータをコピーしてシート2に貼り付け、シート1で可視セルを選択して削除という方法をとっていました。 今回、条件にするキーワードが3個になったので、フィルタオプションの設定で、シート2のA1からA4にキーワードを入れて、検索条件範囲を指定してデータを抽出したので、今までの方法が使えなくなってしまいました。 参考までに、↓こんな感じです。 Sheets("Sheet2").Select Range("A1") = "条件" Range("A2") = "キーワード1" Range("A3") = "キーワード2" Range("A4") = "キーワード3" Sheets("Sheet1").Cells.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _ Range("A1:A4"), CopyToRange:=Range("A6"), Unique:=False
- 締切済み
- オフィス系ソフト
- VBAでオートフィルタ抽出後コピペ
VBA初心者で勉強中の者です。 『工事台帳シート』からオートフィルタで抽出したものを、『工事別表示シート』にコピペするコードをつくりました。 以下のものです。 Sub 工事抽出コピペ() Dim Obj As Object With Sheets("工事台帳") Set Obj = .Range("E5:E65536").Find(.Range("E2"), LookAt:=xlWhole) If Obj Is Nothing Then MsgBox "見つかりませんでした。" Sheets("工事別表示").Range("B11:F65536").ClearContents Exit Sub Else .Range("B6").AutoFilter Field:=4, Criteria1:=.Range("E2").Value .Range("F5:J65536").Copy End If End With Sheets("工事別表示").Range("B11").PasteSpecial Paste:=xlPasteValues Application.CutCopyMode = False End Sub これを起動させると、 Sheets("工事別表示").Range("B11").PasteSpecial Paste:=xlPasteValues の部分が黄色くなり、 実行時エラー'1004'「コピー領域と貼付領域の形が違うため、情報を貼り付けることができません」 という表示が出てきます。 これはどういう意味なのでしょうか? ちなみにコピー領域セルも貼付領域セルも結合はなく、行・列の幅も同じです。 このコードもいろいろな本やサイトで教えてもらったのを参考に作っているので、私自身深く理解せずに書いているところもあります。 どなたか教えてくださる方、よろしくおねがいします。
- ベストアンサー
- オフィス系ソフト
- エクセルのマクロで検索・抽出したデータを修正及び更新して元データに反映
エクセルのマクロで検索・抽出したデータを修正及び更新して元データに反映させたい。 Sheet1に元データが行単位で入力されています。。 A B C D E F 1 日付 顧客名 契約料 担当 回収日 回収金額 2 3 | 50 Sheet2で複数条件でフィルタオプションをマクロで実行し結果を表示ています。 A B C D E 1 日付~ 日付マデ 顧客名 担当者 2 1/1 2/28 高橋 --------->検索条件 3 4 日付 顧客名 担当 回収日 回収金額 5 -------------------------------------->抽出結果 6 -------------------------------------->抽出結果 7 -------------------------------------->抽出結果 マクロは下記の通りです。 Public Sub 検索() Dim myRow1 As Long, myRow2 As Long '----Sheet1とSheet2のA列で最終行を捜します。 myRow1 = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row myRow2 = Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row '----Sheet2のA5以下が入力されていたらクリアします。 If myRow2 >= 5 Then Sheets("Sheet2").Range("A5:P" & myRow2).ClearContents End If '----フィルタオプションの設定で抽出します。 '----元データはSheet1、抽出条件はSheet2のA1:D2、抽出先はSheet2のA4:E4です。 Sheets("Sheet1").Range("A1:F" & myRow1).AdvancedFilter _ Action:=xlFilterCopy, _ CriteriaRange:=Sheets("Sheet2").Range("A1:D2"), _ CopyToRange:=Sheets("Sheet2").Range("A4:E4"), _ Unique:=False End Sub 抽出結果の各セルデータを必要に応じて変更・修正(選出結果を直に)をしそれを元データ に反映(上書き?)させるようなマクロを作成したいです。 どなたかご指導よろしくお願いいたします。 うまく説明できないので画像を添付します。
- ベストアンサー
- オフィス系ソフト
- EXCELマクロ セルに入力したシート名から参照
よろしくお願いします。 複数のシートがあり、それぞれ 1109,1110,1111,1112,1201,1202,1203,1204,1205 と名前がついています。 それぞれのシートには月毎のデータが入っています。 Sub Macro1() Columns("F:J").Select Selection.ClearContents Sheets("1205").Columns("A:E").AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Range("C4:E5"), CopyToRange:=Range("F2:J2"), Unique:=False End Sub ↑のマクロをSheet3で作りましたが、4行目の「Sheets("1205")」の1205の部分を可変で作れればと 思っています。Sheet3のC3セル内に入力したシート名(1109や1203等)でフィルタ出来ると助かります。 どうぞよろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- iPadで使用しているキーボードが突然ペアリングできなくなった場合、再登録や再起動を試しても解決しないことがあります。
- この場合、まずはキーボードとの接続を解除し、iPadのBluetooth設定から削除します。
- その後、iPadとキーボードを再びペアリングし、正しく接続されるか確認してください。また、キーボードの電池残量が低い場合もペアリングができないことがありますので、電池の残量を確認しましょう。
お礼
>プログラミングの方に質問すればもう少しいい回答が得られるかもしれません。 次回からそうしてみます。 有難う御座いました。