- 締切済み
VBAが動かない。
初心者ですが、必要にせままれてVBAを習得努力中ですが、参考書からC&Pして何とか動き?始めたが、途中実行時エラー:1004に引っかかって作動しなくなり使用を止めていました。現在1-2-3のロータスのマクロでなんとかしのいでいますが、やはりエクセルを使用しないと物事はスムーズに進みません。これはデータ入力後の作業の出だしのマクロです。どなたかご教授いただけませんか? QT Sub シート挿入() '初回の追加() Worksheets.Add After:=Worksheets("データ_変換") ActiveSheet.Name = "1" 'シート修正の追加() Worksheets.Add After:=Worksheets("1") ActiveSheet.Name = "2" End Sub Sub 初回、修正のデータ抽出() Dim xRange As Range, yRange As Range Dim sName, allName Set xRange = Worksheets("データ_変換").Range("A4").CurrentRegion allName = Array("1", "2") For Each sName In allName Range("D2").Value = sName Set yRange = Worksheets("データ_変換").Range("A1").CurrentRegion xRange.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=yRange, _ CopyToRange:=Worksheets(sName).Range("A1") Next Set xRange = Nothing: Set yRange = Nothing End Sub UNQT 以上ですが、シート1,2を追加した後それぞれのシートに抽出条件回数(D列)である1,2毎にフルデータを抽出するもので、フィールド名は4行目A列からBI列で約2000件のデータです。 当初はなにもしないでマクロ実行時にそれぞれのシートにフルレングスのフィールド行とデータがA1からBI1のフィールド名とともに書き出されました。また自動的に「データ_変換」のフィールド行が同シートの上のA1にコピーされD列の下の2行目に2の数字が書き込まれて作業は無事完了していました。 以上よろしくお願いします。
- みんなの回答 (4)
- 専門家の回答
関連するQ&A
- VBA関数
PC ほぼ素人です。ネットで調べて、下記のコードを作成できました。 バージョンは2007 Sub 抽出() Worksheets("Sheet5").Activate Worksheets("Sheet5").Range(Cells(1, 1), Cells(328, 18)).Clear With Worksheets("Sheet3").Range("A8") .AutoFilter Field:=1, Criteria1:=Worksheets("Sheet3").Range("a2") ''(1) .AutoFilter Field:=2, Criteria1:=Worksheets("Sheet3").Range("b2") ''(1) .CurrentRegion.SpecialCells(xlVisible).Copy Worksheets("Sheet5").Range("A1") ''(2) .AutoFilter ''(3) End With Worksheets("Sheet5").Activate End Sub Sheet5に抽出後、そのデータを書き換え Sheet3へ戻したいのですが可能なのでしょうか? A B C D E F G 1 月 日 得意先 前回 数量 今回 数量 2 3 5 A商事 1月15日 2 2月5日 3 抽出後、Sheet3には、ABDEFGを戻したいのです。 説明不足かもしれませんが、どうか宜しくお願い致します。
- ベストアンサー
- Visual Basic
- エクセルVBAでのフィルタオプションについて
マクロの記録を利用して、自分なりに本を参考に以下のように手直しをしてみました。 やりたいこととしては、 名前の定義で“仕入単価他”とつけてあるデータから sheet1のB列に入力した内容(抽出条件)を sheet2に抽出するということです。 sheet1の抽出条件はB列に入力します。 フィルタオプションの“OR”のようになり、 抽出する条件は複数行です。(列はB列のみ) 以下のようなコードで実行をすると、 B列の一番最初に書いたものの内容を抽出してくるだけで、複数のデータを引っ張ってきてくれません。 いろいろと直してはみたのですが、どうしても最初の条件のみを見て抽出してしまいます。 どのように手直ししてよいのかわからなくなってしまいましたので、教えてください。 Dim 検索 As Range Dim 範囲 As Range Set 検索 = Worksheets(1).Range("B1").CurrentRegion Set 範囲 = Worksheets(1).Range("B65536").End(xlUp).Offset(5) Worksheets(1).Activate Range("仕入単価他").AdvancedFilter Action:= _ xlFilterCopy, CriteriaRange:=検索, _ CopyToRange:=Range("B65536").End(xlUp).Offset(5), Unique:=False Range("B65536").End(xlUp).CurrentRegion.Copy _ Destination:=Worksheets(2).Range("A1") End Sub
- ベストアンサー
- オフィス系ソフト
- Excel VBA ループについて
Excel VBA勉強中の者です。 シート名「一覧」のA列に入力されている「1」を検索し、メッセージボックスに表示させています。 現在、「1」はA3、A5、A7に入力されています。 下記のコードだとA3、A5、A7がメッセージボックスで表示された後、もう一度A3が表示されてしまいます。 A7が表示された時点で終わりにしたいのですが、どこを修正すればいいのでしょうか? Sub test() Dim xRange As Range Dim fPlace As String Dim i As Integer Dim xMoji As String xMoji = 1 Set xRange = Worksheets("一覧").Range("A1:A100").Find(What:=xMoji) If Not xRange Is Nothing Then fPlace = xRange.Address Msgbox xRange.Address Do Set xRange = Worksheets("一覧").Range("A1:A100").FindNext(After:=xRange) If Not xRange Is Nothing Then Msgbox xRange.Address End If Loop Until fPlace = xRange.Address End If End Sub よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- VBAがうまく動きません。
エクセルVBAで実行時は正確に動かないが、ステップインでは正常に作動するのはなぜですか? 入力シートに入力された情報を元にデータシートから抽出を行い、新規シートを開き、そこでリストにしたい情報のみを編集(不要なタイトル行などの削除)して、自動で貼り付けと名前の定義を行うマクロを作っています。 ステップイン[F8]や実行[F5]では正常に作動するのですが、実際に使用してみると、抽出データが貼り付けされていない状態(セルは空白)となりますが、名前の定義は抽出データと同じ行まで定義されているので、貼り付けのみ上手くいっていないように思われます。 下記が作成したコードです。情報が足りないようでしたら、申し訳ありません。 お手上げ状態となっていますので、お力添えいただけると幸いです。 Dim syurui as String Dim suuryou as Integer Dim target as Range Private Sub Worksheet_Change(ByVal target As Range) If Intersect(target, Range("D7")) Is Nothing Then Exit Sub Else Call 抜出 End If End Sub Sub 抜出() Worksheets("データ").Activate ’後に出てくる名前初期化でエラーを防ぐため仮定義 ActiveWorkbook.Names.Add Name:="番号", _ RefersTo:=Worksheets("データ").Range("K2") syurui = Worksheets("入力").Range("D9").Value Worksheets("データ").Select Set target = Worksheets("データ").Range("M2") With Worksheets("データ").Range("D1") .AutoFilter field:=4, Criteria1:=syurui .CurrentRegion.SpecialCells(xlVisible).Copy With Worksheets.Add .Paste ’不要な行を削除 .Rows(1).Delete .Range("A:D").Delete .Range("B:F").Delete ’抽出した情報を貼り付け&新規シート削除 .UsedRange.Copy target Application.DisplayAlerts = False .Delete Application.DisplayAlerts = True End With .AutoFilter End With ’抽出データの最終行を調べる suuryou = Worksheets("データ").Cells(65536, "M").End(xlUp).Row If suuryou = 1 Then Worksheets("入力").Activate Exit Sub Else Range("番号").Name.Delete ActiveWorkbook.Names.Add Name:="番号", _ RefersTo:=Worksheets(”データ").Range("M2:M" & suuryou) End If Worksheets("入力").Activate End Sub
- 締切済み
- Visual Basic
- 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(エクセル)
- 《エクセル2000VBA》これで実行時エラー '1004'が出るのはなぜでしょう?
こんにちは。VBAの実行時エラーで困っています。 内容を抜粋したものが、下記のものになります。 If Worksheets(sname1).Range("M6") <> Empty Then MsgBox (sname1) MsgBox (Worksheets(sname1).Range("M6")) '該当入力シートの一番下の行を探す Worksheets(sname1).Range("M65536").End(xlUp).Offset(1).Select sname1はシート名の変数です。 2つのMsgBoxが間違いなく表示されますので、sname1に存在するシート名は入っていると思います。 今の状態で、該当入力シートの一番下の行を探す時点で実行時エラーが出てしまうのですが、なぜでしょうか?
- ベストアンサー
- オフィス系ソフト
- 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列それぞれはできるのですが、データが重複してしまいます。 重複分を削除するため、セル入力で連番を降って、重複するものを削除しようとしましたがうまくいかず。 なにかいい方法はないでしょうか。
- ベストアンサー
- オフィス系ソフト
- エクセルマクロVBAについて
エクセルマクロVBAについて、こんなこと出来ますか? ■A列からAS列の1行目にヘッダー情報をもつデータベース ■A列に担当者名 ■A列にオートフィルタをかけて各担当ごとにデータを抽出したものを別シートに貼り付けて自動印刷したい ■担当者は都度変わるので、Criteria1:="xxx"というようには直接書けない(担当名を自動で抽出したい) ■担当者の数も都度変わる ■補足 一行のデータを特定の雛形に転記する必要があるので別シートに出したいです ちなみに、アナログで記録したコードは以下です。 Sub test1() Sheets("データ抽出シート").Select ActiveSheet.Range("$A$1:$AS$300").AutoFilter Field:=1, Criteria1:="山田" Range("$A$1:$AS$300").Select Selection.Copy Sheets("抽出データ貼付シート").Select Range("A1").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False ActiveWindow.SelectedSheets.PrintOut Copies:=1 Sheets("データ抽出シート").Select ActiveSheet.Range("$A$1:$AS$300").AutoFilter Field:=1, Criteria1:="斉藤" Range("$A$1:$AS$300").Select Selection.Copy Sheets("抽出データ貼付シート").Select Range("A1").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False ActiveWindow.SelectedSheets.PrintOut Copies:=1 Sheets("データ抽出シート").Select ActiveSheet.Range("$A$1:$AS$300").AutoFilter Field:=1, Criteria1:="田中" Range("$A$1:$AS$300").Select Selection.Copy Sheets("抽出データ貼付シート").Select Range("A1").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False ActiveWindow.SelectedSheets.PrintOut Copies:=1 End Sub これ、担当者の抽出を自動でなんとかなりませんか?
- 締切済み
- オフィス系ソフト
- オートフィルタ抽出データをコピーするマクロについて
マクロについて勉強中の者です。 "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の日付範囲の抽出について
作業SheetのC列から日付で範囲指定して検索された行を検索workへ行をコピーしたいのですが、 日付の抽出がうまくできません。どなたかご教授願います。 また、できることなら、オートフィルタを利用せずに抽出したいのですが、書き方がわかりません。 素人の質問で申し訳ございませんが、よろしくお願いします。 開始年月日 = ">=" & S受付日Box.Text 終了年月日 = "<=" & E受付日Box.Text Worksheets("作業Sheet").Range("C1").AutoFilter _ Field:=3, _ Criteria1:=開始年月日, _ Operator:=xlAnd, Criteria2:=終了年月日 Worksheets("作業Sheet").Range("A2").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy _ Worksheets("検索work").Range("A2") Worksheets("検索work").Range("2:2").Delete 'タイトル行の削除 MsgBox "抽出が完了しました。「検索結果の表示」ボタンから確認してください"
- 締切済み
- Visual Basic
お礼
ありがとうございます。 試して見ましたが、だめです。 今回は 実行時エラー:21476259 AdvanceFilterメッソッド失敗しました Rangeオブジェクト。。。 尚、以上は貴アドバイスまえに実行したときも同じエラーです。 ますます深みにはまる様です。 1,2のシートは削除し、挿入する以外は一切手を着けていません。 またアクティブの件は、マクロ実行時必ず本体シートのA5(データの頭)にクリックをしてから行っています。 業務の出だしのマクロなので何とかブレイクスルーできればと思っています。 以上ご報告まで。