EXCEL VBA 作業用シートの使い回し

このQ&Aのポイント
  • データのあるシートから、一定の条件にあうデータを当初から用意した作業用シート抜き出してきた上で、抜き出したシートの1つの列にあるデータ集から重複のないデータを抜き出すため、advancedfilterを使用しています。
  • 別のサブルーチンを作成して、同一作業用シートを使い回す形で上記の作業を実行すると、表題のみコピーしてデータをコピーしなくなる現象が生じました。
  • 作業用シートを削除して、新たにシートを挿入して作業用シートと名前を付けて、advancedfilterを実行すると、正常に機能しました。このような現象がおきる理由をご教示願います。この現象を避けるには、作業用シートをサブルーチンごとに挿入・削除を繰り返す必要が生じ、処理スピードが落ちると予想されます。よき、アドバイスがあればよろしくお願いします。
回答を見る
  • ベストアンサー

EXCEL VBA 作業用シートの使い回し

データのあるシートから、一定の条件にあうデータを当初から用意した作業用シート抜き出してきた上で、抜き出したシートの1つの列にあるデータ集から重複のないデータを抜き出すため、advancedfilterを使用しています。 別のサブルーチンを作成して、同一作業用シートを使い回す形で上記の作業を実行すると、表題のみコピーしてデータをコピーしなくなる現象が生じました。 作業用シートを削除して、新たにシートを挿入して作業用シートと名前を付けて、advancedfilterを実行すると、正常に機能しました。 このような現象がおきる理由をご教示願います。 この現象を避けるには、作業用シートをサブルーチンごとに挿入・削除を繰り返す必要が生じ、処理スピードが落ちると予想されます。 よき、アドバイスがあればよろしくお願いします。 Sub フィルター() Dim rows As Double '重複を削除した番号リスト作成 With Worksheets("作業用") rows = .Range("b65536").End(xlUp).Row .Range(.Cells(6, 3), .Cells(rows, 3)).AdvancedFilter Action:=xlFilterCopy, _ copytorange:=.Range("N6"), unique:=True End With End Sub

質問者が選んだベストアンサー

  • ベストアンサー
noname#32244
noname#32244
回答No.1

直接の回答ではありませんが、 VisualBasicEditorから、 Application.ScreenUpdating = False に設定してステップ実行し、 実際に動いているところを見てデバックしてみると すぐ問題点が判明するかもしれません。 関係ないかもしれませんが、一つ気になる点として、 dim Rows as Double の変数名は、エクセルが混乱してよろしくない気がしますので、 dim lRow as Long などのほうが良い気がします。

yoshio2
質問者

お礼

ご教示ありがとうございます。 重複データなしのデータを抽出するためadvancedfilterを実行する際にCriteriaを指定しないでコードを実行するとVBAが自動的にシート上のセルにCriteriaという名前をつけており、そのCriteriaが残ることが問題なことが分かりました。 このCriteriaという名前を削除するコードを加えたところ、正常に機能するようになりました。 このCriteriaという名前が自動的に作成される現象については、別に質問をしてみたいと思っています。

関連するQ&A

  • エクセルVBA  どうしても動きません。

    お世話になります。 なかなか上達しない超初心者です。 ↓↓ですが、Activesheetにすると動くのに、シート名を元々存在するシート”実験"に指定すると動きません(データ内容はまったく同じで、A列に色んな名前が入っていて、重複しているとC列に重複と入力します)。 2日間試行錯誤したのですが、やっぱり動かず・・・ ちなみに、Activateにするとアクティブになるし、CurrentRegionも選択できるのに なんでうごかないんでしょうか・・・ 何卒ご指導くださいませ。よろしくお願いいたします!!!!!! Sub Test2() With Sheets("実験").Range("A1").CurrentRegion Dim i As Long Dim LastRow As Long LastRow = Range("A" & Rows.Count).End(xlUp).Row For i = 1 To LastRow If WorksheetFunction.CountIf(Range("A:A"), Cells(i, 1)) > 1 Then Cells(i, 3) = "重複" End If Next i End With End Sub Sheets("実験")をActivesheetに変えると別のシートがしっかり動いてくれます・・・が、なんとしてでも”実験”シートに動いていただきたいです・・・。

  • EXCEL Advancedfilter Name(Criteria)の自動作成

    重複データから重複のないデータを抜き出すため、下記のようにCriteriaRangeを指定せずに、Advancedfilterを実行していますが、その際にシートの特定のセルにCriteriaという名前(Nameオブジェクト)が自動的に作成され、それが残る現象が生じます。 シートにその名前(Criteria)が残ると、別のSUBで重複データから重複のないデータを抜き出すためAdvancedfilterを実行すると機能しません(表題部だけ抜き出してくる)。 そこで、2点ご教示いただければ幸いです。 1 Criteriaを残さないAdvancedfilterの実行方法 2 残ってしまうCriteriaを削除する方法として、下記のコードを加えていますが、Namesコレクションの特定のName(Criteria)を特定して削除させていますが、この方法は=を使っていることが、後日のコード解析を分かりづらいものにするため、避けた方がよいと別に指導を受けているため、これ以外の効率的な方法があればご教示願います(例えば、Nameのプロパティを変更する方法による対処方法)。 Criteriaを削除するコード   Dim Objname As name For Each Objname In ActiveWorkbook.Names If Objname.name = "作業用シート!Criteria" Then Objname.Delete End If Next Objname Advancedfilterのコード   With Worksheets("作業用シート") M = .Range("B10000").End(xlUp).Row .Range(.Cells(6, 5), .Cells(M, 5)).AdvancedFilter _ Action:=xlFilterCopy, _ CopyToRange:=.Range("AA6:AA2000"), Unique:=True end with  

  • EXCEL VBAの重複行削除について

    EXCEL2010を使用しています。 添付画像の「重複行削除 前」の表を、RemoveDuplicatesで下の様にコードを組んで A列で重複する行を見て重複する行を削除しています。 Public Sub 重複行削除()  With WorkSheets(1)   .Range(.Cells(1, 1), .Cells(8, 3)).RemoveDuplicates _      Columns:=1, Header:=xlYes  End With End Sub すると、日付の新しいデータが削除され、古いデータが残ってしまいます。 (添付画像の「重複行削除 後」) ReniveDuplicates Columns:=Array(1,3) とした場合は、すべてのデータが残ってしまいます。 添付画像の「欲しいデータ」の表の様に、 日付の新しいものを残すように重複行削除は出来ないでしょうか? 詳しい方、どうか教えてください。 よろしくお願いします。

  • VBA RemoveDuplicatesが動かない

    以下のマクロを実行しても動きません。 RemoveDuplicatesの行でエラーとなります。 メッセージ:アプリケーション定義またはオブジェクト定義のエラーです。 何が間違ってるのでしょう? エクセル2013 Windows8 E列の重複を削除するマクロです。不要なWithを使っているのは、別マクロから切り出したものだからです。 Sub test() Dim Colref As Long, LastRow As Long With Worksheets("Sheet1") Colref = 5 LastRow = Cells(Rows.Count, Colref).End(xlUp).Row Range(.Cells(1, Colref), .Cells(LastRow, Colref)).RemoveDuplicates Columns:=CVar(Colref), Header:=xlNo End With End Sub

  • VBA:2つの異なるシートからグラフを作成する

    VBA初心者です。(はじめてから3日目。。。) もしかすると、すごい簡単なことなのかもしれなくて申し訳ないのですが、質問させてください。 二つの異なるシートのデータを使って、円グラフを作製しようとしています。 ですが、「アプリケーション定義またはオブジェクト定義のエラー」が出てしまいます。 どこが間違っているのかをご教授願えませんでしょうか。 よろしくお願いします。 Sub graph() Charts.Add With ActiveChart .ChartType = xlPie .SeriesCollection(1).XValues = Worksheets(1).Range(Cells(2, 3), Cells(2, 5)) .SeriesCollection(1).Values = Worksheets(2).Range(Cells(3, 2), Cells(3, 4)) .SeriesCollection(1).Name = Worksheets(1).Cells(1, 1) .Location where:=xlLocationAsObject, Name:="sheet3" End With End Sub ちなみに、各セルにはちゃんとデータが入っております。 よろしくお願いいたします。

  • エクセル VBA 特定文字がある行を別シートに移動

    ソフト excel2003 o列に文字列が入力された表があります。 マクロ実行時下記のようにするには、VBAのコードをどのように記入すればよろしいでしょうか? 赤枠で囲んだボタンをクリックすると シート1のO列に 中 が入力されている行を切り取りし中シートに貼り付け (下の行は上方向にシフト) ※ シート1の内容は日毎に更新されますので、更新後、赤枠で囲んだボタンをクリックするとその時点で 中 が入力されているものは中シートのリストへ追加されるようにしたいのです。 以前ここで教えていただいたものを参考に作成してみたの(以下に記載)ですがうまくいきません。 お助けいただけないでしょうか。 宜しくお願い致します。 Sub ボタン中シート_Click() 'Sheet2の挿入位置(C列は結合セルではなく、必ず何か入っている事) nMax2 = Sheets("中シート").Cells(Rows.Count, 3).End(xlUp).Row + 1 With Sheets("sheet1") nMax1 = .Cells(Rows.Count, 9).End(xlUp).Row For i = nMax1 To 2 Step -2 If .Cells(o, 15) = "中" Then .Range(.Cells(o, 1), .Cells(o + 1, 10)).Copy Sheets("中シート").Cells(nMax2, 1).Insert Shift:=xlDown .Range(.Cells(o, 1), .Cells(o + 1, 10)).Delete Shift:=xlUp End If Next i End With End Sub

  • エクセルVBA 1つのシートで出来ますか?

    説明が下手で申し訳ございませんが、宜しくお願い致します。 sheet(1)に20個のボタンがあります。 ボタンをクリックすると、別のシートが開きます。 開いたシートにも複数のボタンがあり、そのうちの任意のボタンをクリックすると、そのボタンの値がsheet(1)のそれぞれのボタンに対応したセルに入力される、という動作を実現したいと思っています。 現状、下記のようなコードで目的の動作は実現できてはいるのですが、各ボタンそれぞれにシートを作っているような状況です。(データ自体は全く同じ内容のものが、計20シート) たぶん、もの凄く頭の悪い事をやっているんだろうと思います。 sheet(1)を除いた各シートの入力データ自体は全く同じなので、シート一枚で出来るんじゃないのかなと思い、ネットや本で調べながら色々試してみたのですが、どうも上手く行きません。データが同じでも、sheet(1)のクリックしたボタンによって入力するセルを変えなければならないのが問題です。 sheet(1)のボタンとセルの関連付けや、sheet(1)のどのボタンを押したのかの判別ができればいいのかなと思って調べてみても、初心者にはよく理解できず、もう何週間もチャレンジしているのですがお手上げです。 上級者の方の知恵をお借りできれば幸いです。 Sub sheet2を開く() Worksheets(2).Select End Sub Sub 入力1() Worksheets(1).Range("F8") = "データ1" Worksheets(1).Select End Sub Sub 入力2() Worksheets(1).Range("F8") = "データ2" Worksheets(1).Select End Sub Sub 入力3() Worksheets(1).Range("F8") = "データ3" Worksheets(1).Select End Sub Sub sheet3を開く() Worksheets(3).Select End Sub Sub 入力1() Worksheets(1).Range("H8") = "データ1" Worksheets(1).Select End Sub Sub 入力2() Worksheets(1).Range("H8") = "データ2" Worksheets(1).Select End Sub Sub 入力3() Worksheets(1).Range("H8") = "データ3" Worksheets(1).Select End Sub Sub sheet4を開く() Worksheets(3).Select End Sub Sub 入力1() Worksheets(1).Range("M8") = "データ1" Worksheets(1).Select End Sub Sub 入力2() Worksheets(1).Range("M8") = "データ2" Worksheets(1).Select End Sub Sub 入力3() Worksheets(1).Range("M8") = "データ3" Worksheets(1).Select End Sub    ・    ・    ・    ・    ・

  • EXCEL VBAの配列でわかりません。

    こんなコードがあるのですが、最後の他のシート(作業中シート)に書き込もうとするとエラーになってしまいます。”Sheets("作業中").”を抜くと同じシートに結果は返ってくるのですが…。コードの内容は、ある範囲のある列から空白ではないセルを探し出してその行のデータを配列で汲み取り、他のシートに一括で洗い出すというものです。 Sub 作業中() Dim myRow As Long Dim Data As Variant Dim WC() As Variant Dim WCE() As Variant myRow = Range("H1").CurrentRegion.Rows.Count Data = Range("H1:M" & myRow).Value For i = 1 To myRow If Data(i, 5) <> "" Then a = a + 1 Else b = b + 1 End If Next ReDim WC(a) ReDim WCE(b) c = 0 d = 0 For i = 1 To myRow If Data(i, 5) <> "" Then WC(c) = Range("H" & i & ":K" & i).Value c = c + 1 Else WCE(d) = Range(Cells(i, 8), Cells(i, 11)).Value d = d + 1 End If Next For i = 0 To a Range(Cells(i + 1, 15), Cells(i + 1, 18)).Value = WC(i) Next For i = 0 To b Range(Cells(i + 1, 19), Cells(i + 1, 22)).Value = WCE(i) Next e = Range(Cells(1, 15), Cells(a, 18)).Value Sheets("作業中").Range(Cells(1, 1), Cells(a, 4)).Value = e End Sub ちなみに同じシートから↓のコードを実行するとうまくいきます。 なぜ~??わからな~い??おしえてくださーい!! Sub test() Dim a As Variant a = Range("H1:K4") Sheets("作業中").Range("N1:Q4") = a End Sub

  • vba エクセル

    2行目から、最終行までEmptyにしたいのにならないです。 1行目はフィールド行なのに、そのままにしたいのですが 2行目から最終行は空白にしたいです。 なので Sub TEST() With Sheets("log") lastRow = .Cells(.Rows.Count, "b").End(xlUp).Row LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column .Range(.Cells(2, LastCol), .Cells(lastRow, LastCol)) = Empty End With End Sub としたのですが、何も起こりません。 lastRowは100、LastColは5なのですが、 このマクロを実行しても何も起こらないです。 なぜでしょうか?

  • マクロで全てのシートで条件を満たすシートに行を挿入するにはどうしたらいいですか

    マクロ初心者です。自分でも作ってみたのですが、なかなか思うようにいかず困っています。 book内のシート3つ目から最後のシートで、条件に一致するシートの特定位置に行を挿入するということがしたいのですが。 条件とは、1列目の最後の行に「合計」と記入されていれば、行を4行挿入し、上の書式をコピーするというものです。 下記に記しているマクロは、シートを指定した場合には動くのですが、これにシートをnとして、FOR...Nextを付け加えてシートを順番に参照させようとしても、うまくいきません。 Sub 行挿入sample3() With Sheets("10007") For i = 7 To .Cells(Rows.Count, 1).End(xlUp).Row If .Cells(i + 1, 1) = "" Then Exit For ElseIf .Cells(i + 1, 1) = "合計" Then Range(Cells(i + 1, 1), Cells(i + 4, 1)).Select Selection.EntireRow.Insert Range(Cells(i, 1), Cells(i, 3)).Select Selection.Copy Range(Cells(i + 1, 1), Cells(i + 4, 3)).PasteSpecial xlPasteFormats End If Next i End With End Sub 知識をお持ちの方、教えていただけるととても助かります。よろしくお願いします。

専門家に質問してみよう