エクセルVBAでシートに条件を付けて処理させたい

このQ&Aのポイント
  • エクセルVBAで『あああ』シートと『いいい』シートと『ううう』シートの情報を『コピー用』シートにコピーする処理を作成しました。しかし、シートの内容が変更された場合や処理ボタンが押されていない場合にダイアログを表示して処理を選択させたいです。
  • 具体的には、『あああ』シートか『いいい』シートか『ううう』シートが変更されていて、かつ処理ボタンが押されていない場合に、「コピー用」シートをアクティブにしたときにマクロ処理をするかどうかを選択させるダイアログを表示します。
  • ただし、シートが変更されていない場合や処理ボタンが押された後にシートが変更されていない場合は、ダイアログを表示せずにマクロ処理を実行します。詳細なコードの実装方法は、参考ページをご覧ください。
回答を見る
  • ベストアンサー

エクセルVBAで、シートに条件を付けて処理させたい

エクセルVBAで 『コピー用』シートと『あああ』シートと『いいい』シートと『ううう』シートがあり、 『あああ』シートと『いいい』シートと『ううう』シートの全ての情報を 『コピー用』シートにコピーしてまとめるようにしました。 マクロを処理するには、 『あああ』シートと『いいい』シートと『ううう』シートに設置したボタンを押すと処理する。 ここまでは実現することができました。 私がやりたいことは、 シートの内容を変更したのに、そのボタンを押し忘れてしまい、 そのまま『コピー用』シートを使用してしまうことを避けるために、 【「あああ」シートか「いいい」シートか「ううう」シートが変更されている】 かつ 【マクロを処理させるボタンを押していない】 この場合に、「コピー用」シートをアクティブにしたときに マクロ処理をするかしないかを選択させるダイアログを表示させる。 シートが変更されていない または マクロを処理させるボタンを押した後にシートを変更していない この場合は、「コピー用」シートをアクティブにしたときに マクロ処理をするかしないかを選択させるダイアログは表示させない。 といった処理を可能にしたいです。 詳しくは↓のサンプルページを参考にして下さい。 http://blog-imgs-17.fc2.com/s/k/s/sksfiosjdijf34/sampledesu.htm ボタンを押して全シートをコピーする処理のコードは↓のような感じで作りました。 ダイアログの処理は調べて作ってみましたが、ちゃんと動作しませんでした。 Microsoft Excel Objectsのsheet1(sheet2とsheet3とsheet4は空白)に Private Sub Workbook_SheetActivate(ByVal Sh As Object) Dim keizoku As Integer keizoku = MsgBox("内容が変更されていますが、「あああ」シートか「いいい」シートか「ううう」シートのマクロ処理開始のボタンをまだ押していないためマクロ処理がされていません。処理しますか?", vbYesNo) Select Case keizoku Case vbYes Application.EnableEvents = False Call macro1 Application.EnableEvents = True Case vbNo myMsg = "" Case Else myMsg = "" End Select End Sub を入れ、 次に、標準モジュールのModule1に Sub macro1() Worksheets("あああ").Range("B2:AD51").Copy _ Destination:=Worksheets("コピー用").Range("B1:AD50") Worksheets("いいい").Range("B2:AD51").Copy _ Destination:=Worksheets("コピー用").Range("B51:AD100") Worksheets("ううう").Range("B2:AD101").Copy _ Destination:=Worksheets("コピー用").Range("B101:AD200") Application.ScreenUpdating = False For RowCount = 400 To 1 Step -1 If Application.WorksheetFunction.CountA(Worksheets("コピー用").Rows(RowCount)) = 0 Then Worksheets("コピー用").Rows(RowCount).Delete End If Next Application.ScreenUpdating = True Application.OnKey "a" End Sub を入れました。 詳しくは↓のサンプルページを参考にして下さい。 http://blog-imgs-17.fc2.com/s/k/s/sksfiosjdijf34/sampledesu.htm アドバイスをお願いいたします。

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

  • ベストアンサー
  • imogasi
  • ベストアンサー率27% (4737/17068)
回答No.1

忙しい読者や回答者のことを考えて、質問をもっと短く、また要点に絞り、要領よくかけないのか。 たとえば家庭教師に要求するように、そっくり放り投げて、回答を頼んでないか。 ーー 3つのシートがあってコピーするときは、一部のシートに変更が無くても、3つにシートをコピーしてしまうのはどうか。 細かく言えば無駄なのだが、よい方法が見つからないとか、自分のプログラム作成力との兼ね合いで、そちらのほうを選ぶのも良いのでは。 (一部セルの値の変化なのだが、個別のセルのコピーは面倒なので、1シート全体をコピーするようなこともその例に当たる) ーー そもそも各シートの変更を捕まえる(それも前回コピー後に限る)仕組みはどうしたのか。 (If ActiveWorkbook.Saved = True Thenはブック全体のようなので不適か) この点も含め、まずロジック(処理の仕組み)が、どういうのが良さそうか(どういうVBAの機能を使うべきか)、から質問しては。(もちろん自分でやってみることは大切なのだが) 初心者はこのへんの大切さを重視せず、少ない経験の中から、知っている範囲の我流でやろうとする。すると仕組みやコードは変に複雑になったり、難しくなる場合がある。 そして、そのコードは質問者が作り、行き詰った点に絞って質問すべきだ。 ーー 変化を捉えるのは(Change)イベントしかない 対象シートが3つあるので、Thisworkbookのシートのイベントを使う。変化したシートが判別できるから。 イベントプロシージュア以外で、変化の結果を使うので、フラグを、それもパブリック変数で、設けざるを得ない。 シートごとにフラグが必要かと思う。 このフラグはONで在ればコピーを必要とし、コピーしたら、コピーの処理の最後で、そのシートの分のフラグをOFFにする。 また上記Workbook_SheetChangeイベントは、どんな変化を拾うか。質問者のニーズに合うかどうか。 十分はテストして無いし、十分良いかどうかわからないが ーー Sheet1,Sheet2の2つで Sheet1にボタン1つ設ける。 Private Sub CommandButton1_Click() If chg1 = "y" Then MsgBox "その後Sheet1変更されている" chg1 = "" ElseIf chg2 = "y" Then MsgBox "その後Sheet2変更されている" chg2 = "" Else MsgBox "変更なし" End If End Sub 標準モジュールに Public chg1, chg2 (上記はボタンをクリックして、照会しただけで、処理は済んだことになるが。本来はSheet1などの変更を「コピー」用シートに 何衛反映する処理が必要だが略。)

tekkenman7
質問者

補足

ありがとうございます。さっそく試してみました。 Microsoft Excel ObjectsのSheet1(コピー用)を Private Sub CommandButton1_Click() If chg1 = "y" Then MsgBox "その後Sheet1変更されている" chg1 = "" ElseIf chg2 = "y" Then MsgBox "その後Sheet2変更されている" chg2 = "" Else MsgBox "変更なし" End If End Sub に変更し、 標準モジュールを Public chg1, chg2 Worksheets("あああ").Range("B2:AD51").Copy _ Destination:=Worksheets("コピー用").Range("B1:AD50") Worksheets("いいい").Range("B2:AD51").Copy _ Destination:=Worksheets("コピー用").Range("B51:AD100") Worksheets("ううう").Range("B2:AD101").Copy _ Destination:=Worksheets("コピー用").Range("B101:AD200") Application.ScreenUpdating = False For RowCount = 400 To 1 Step -1 If Application.WorksheetFunction.CountA(Worksheets("コピー用").Rows(RowCount)) = 0 Then Worksheets("コピー用").Rows(RowCount).Delete End If Next Application.ScreenUpdating = True Application.OnKey "a" End Sub に変更するということでしょうか。 エラーになってしまうのですが、何が間違っているのでしょうか。

その他の回答 (1)

回答No.2

(1)一つのエクセル上の各シートデータを、マスターシートにコピーするのであれば、エクセルを立ち上げたときに自動的に3つのシートからマスターシートにコピー処理するようにすればOKです。こうすれば各シートに変更があろうが無かろうが、マスターシートは、常に最新の状態になります。 (2)さらに、マスターシートのところで、コピーボタンをつけて同じようにできる様にしておけば、作業時にも最新の状態にできます。 この2つを考えてみたらどうでしょうか。

tekkenman7
質問者

補足

ありがとうございます。 すみません、自分の実現したいことと少し違うようです。 (1)エクセルを開く   ↓ (2)シートの内容をいろいろ変更   ↓ (3)マクロの処理の開始   ↓ (4)変更ヶ所をみつけてまた変更   ↓ (5)マクロの処理の開始を忘れる   ↓ (6)コピー用のシートを印刷(更新されていないシート)   ↓ (7)エクセルを閉じる   ↓ (8)数ヵ月後にエクセルをまた開き同じ作業をする   ↓ (1)エクセルを開く   ↓ (5)が起きても、(6)のような状態にさせないための対策を実現する方法を知りたいです。

関連するQ&A

  • エクセルVBAの別sheetの空白行削除について

    エクセルVBAでBOOK1のsheet1とsheet2とsheet3があり、 sheet1とsheet2の全ての情報をsheet3にコピーしてまとめるようにしました。 マクロを実行するには、Visual Basicを開いてF5を押しています。 それをsheet1かsheet2の中身の一部分でも変更すると そのときに自動的にマクロが実行されるようにしたいです。 sheet1とsheet2(sheet3は空白のまま)に Private Sub Worksheet_Change(ByVal Target As Range) Call マクロ() End Sub を入れ、 次に、標準モジュールに Sub マクロ() '下記よりsheet1とsheet2の内容をsheet3にコピーする Worksheets("sheet1").Range("C1:BE50").Copy _ Destination:=Workbooks("BOOK.xlsm").Worksheets("sheet3").Range("C1:BE50") Worksheets("sheet2").Range("C1:BE100").Copy _ Destination:=Workbooks("BOOK.xlsm").Worksheets("sheet3").Range("C51:BE150") '下記より上記sheet3の状態から余分な空白行を削除する Dim UsedCell As Range Dim Max_Row, RowCount As Integer Set UsedCell = ActiveSheet.UsedRange Max_Row = UsedCell.Cells(UsedCell.Count).Row Application.ScreenUpdating = False For RowCount = Max_Row To 1 Step -1 If Application.WorksheetFunction.CountA(Rows(RowCount)) = 0 Then Rows(RowCount).Delete End If Next Application.ScreenUpdating = True End Sub をやって、sheet1かsheet2のセルを変更すると エクセルが固まってしまいます。 デバックでは Rows(RowCount).Delete がよくないようです。 書き方が間違っているのでしょうか?

  • エクセルVBAでエラー、Changeの使い方が×?

    エクセルVBAでBOOK1のsheet1とsheet2とsheet3があり、 sheet1とsheet2の全ての情報をsheet3にコピーしてまとめるようにしました。 マクロを実行するには、Visual Basicを開いてF5を押しています。 それをsheet1かsheet2の中身の一部分でも変更すると そのときに自動的にマクロが実行されるようにしたいです。 sheet1とsheet2とsheet3に Private Sub Worksheet_Change(ByVal Target As Range) Call マクロ() End Sub を入れ、 標準モジュールに Sub マクロ() Workbooks("BOOK.xlsm").Worksheets("sheet1").Range("C1:BE50").Copy _ Destination:=Workbooks("BOOK.xlsm").Worksheets("sheet3").Range("C1:BE50") Workbooks("BOOK.xlsm").Worksheets("sheet2").Range("C1:BE100").Copy _ Destination:=Workbooks("BOOK.xlsm").Worksheets("sheet3").Range("C51:BE150") Dim UsedCell As Range Dim Max_Row, RowCount As Integer Set UsedCell = ActiveSheet.UsedRange Max_Row = UsedCell.Cells(UsedCell.Count).Row Application.ScreenUpdating = False For RowCount = Max_Row To 1 Step -1 If Application.WorksheetFunction.CountA(Rows(RowCount)) = 0 Then Rows(RowCount).Delete End If Next Application.ScreenUpdating = True End Sub をやって、sheet1かsheet2のセルを変更すると エクセルが固まってしまいます。 デバックでは最初の Workbooks("BOOK.xlsm").Worksheets("sheet1").Range("C1:BE50").Copy _ Destination:=Workbooks("BOOK.xlsm").Worksheets("sheet3").Range("C1:BE50") がよくないようです。 書き方が間違っているのでしょうか?

  • エクセル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 シートのコピー後処理?

    EXCEL2013使用にてフォーム内ボタンより 下記、受注一覧表シートをコピー→一番左に配置して 処理シートに名前を変更して J列基準の昇順に並び変えようとしていますが ActiveSheet.Name = "処理シート"で コードの実行が中断されましたメッセージが出ます。 ActiveSheet.Name = "処理シート"にブレークポイントを置いて F8で進めていきますと処理実行します。 ユーザーフォームは UserForm1.Show 0で開いております。 どの箇所の修正を行えばいいのか ご教示時お願いいたします。 Private Sub CommandButton1_Click() Worksheets("受注一覧表").Copy Before:=Worksheets(1) ActiveSheet.Name = "処理シート" Worksheets("処理シート").Select Rows("8:2328").Select Range("B8").Activate ActiveWorkbook.Worksheets("処理シート").Sort.SortFields.Clear ActiveWorkbook.Worksheets("処理シート").Sort.SortFields.Add Key:=Range("J9:J2328") _ , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal With ActiveWorkbook.Worksheets("処理シート").Sort .SetRange Range("B8:L2328") .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With Range("B8").Select End Sub

  • コピー後に値のみ貼り付け エクセル、VBAの記述について

    マクロ初心者です。 エクセルで選択範囲を指定後コピーし、 自動的に別のシートの末尾に貼り付けられるようにしたのですが、 この内容のまま「貼り付け」を「値のみ貼り付け」に訂正する場合 どのように変更すればいいのか、教えてくださると嬉しいです。 宜しくお願いいたします。 Sub 選択範囲をコピー後、指定シートの末尾に貼り付け Worksheets("sheet1").Activate Range("b11:I17").Copy Workbooks("book2.xls").Worksheets("Sheet1").Activate 行 = Range("B1").CurrentRegion.Rows.Count + 1 ActiveSheet.Paste _ Destination:=Workbooks("book2.xls").Worksheets("Sheet1").Range("B" & 行) End Sub

  • シート間のコピー時の列幅と行の高さ

    マクロ初心者です。下記はシート間のコピーですが、列幅と行の高さも一緒にコピーするにはどのように書いたらよいでしょうか。マクロは"sheet1"に入っています。よろしくお願いいたします。 Sub macro1() Worksheets("sheet2").Activate Cells.Clear Worksheets("sheet1").Activate Worksheets("sheet1").UsedRange.Copy ActiveSheet.Paste Destination:=Worksheets("sheet2").Range("A1") End Sub

  • ExcelのVBAについて質問です。Excelは2003です。

    ExcelのVBAについて質問です。Excelは2003です。 コマンドボタン1で下記のプログラムを実行するようにしています。 Sub Macro1() ' ' Macro1 Macro ' ' Dim iRows As Integer Dim sRows As String Dim i As Integer For i = 1 To 100 Application.Wait Now + TimeValue("00:00:05") ' 最終行の調査: iRows = Worksheets("Sheet1").UsedRange.Rows.Count ' 最終行をシート3にコピー Worksheets("Sheet1").Rows(iRows).Copy Destination:=Worksheets("Sheet4").Range("1:1") ' CH1 の最新データをシート3にコピー Worksheets("Sheet3").Range("B9").Value = Worksheets("Sheet1").Cells(iRows, 3).Value ' CH2 の最新データをシート3にコピー Worksheets("Sheet3").Range("C9").Value = Worksheets("Sheet1").Cells(iRows, 4).Value Next i End Sub これをコマンドボタン2で途中でも強制的に終了するようにしたいのですがコマンドボタン2にはどのようなプログラムを入れればいいでしょうか?

  • エクセルVBAで作ったコードを実行しても動作しない

    エクセルVBAで『データワン』シートと『データツー』シートと『まとめ』シートがあり、 『データワン』シートと『データツー』シートの全ての情報を 『まとめ』シートにコピーしてまとめるようにしました。 マクロを実行するには、Visual Basicを開いてF5を押しています。 それを『データワン』シートか『データツー』シートの中身の一部分でも変更すると そのときに自動的にマクロが実行されるようにしたいです。 Microsoft Excel Objectsのsheet1とsheet2(sheet3は空白のまま)に Private Sub worksheet_change(ByVal Target As Excel.Range) Call macro1 End Sub を入れ、 次に、標準モジュールのModule1に Sub macro1() With Worksheets("まとめ") .Cells.ClearContents On Error Resume Next Worksheets("データワン").Range("C1:BE50").SpecialCells(xlCellTypeConstants).EntireRow.Copy _ Destination:=.Range("A1") Worksheets("データツー").Range("C1:BE100").SpecialCells(xlCellTypeConstants).EntireRow.Copy _ Destination:=.Range("A" & .UsedRange.Rows.Count + 1) End With End Sub を入れました。 『データワン』シートと『データツー』シートの情報を書き換えても 手動でマクロを実行してみましたが、何も起こりません。 書き方が間違っているのでしょうか?

  • Excelマクロについて(セルのコピー)

    今、マクロで自動的にセルのデータを別シートに貼り付けるというものを作っています。 Private Sub コピー定義() Worksheets("sheet1").Activate 'sheet1をアクティブにする コピー元行 = 2 コピー先行 = 1 コピー元セル = "A" & コピー元行 コピー先セル = "A" & コピー先行 Worksheets("sheet1").Range(コピー元セル).Copy _ Destination:=Worksheets("sheet2").Range(コピー先セル) End Sub これで、sheet1のA2からsheet2のA1にコピーできるのですが、 Private Sub コピー定義() Worksheets("sheet1").Activate 'sheet1をアクティブにする コピー元行 = 2 コピー先行 = 1 コピー元行 = 2 コピー先行 = 1 コピー元セル = "A" & コピー元行 コピー先セル = "A" & コピー先行 コピー元セル = "B" & コピー元行 コピー先セル = "B" & コピー先行 Worksheets("sheet1").Range(コピー元セル).Copy _ Destination:=Worksheets("sheet2").Range(コピー先セル) End Sub とすると、B2の項目しかコピーされません。複数のセルを一度にコピーするマクロの作り方をご存じの方、ご伝授下さい。

  • Excel VBA Worksheets(())

    Excel2016をWindows10で使用しています。 以下のマクロが実行できません。 Option Explicit Sub raco() Worksheets("Sheet(3)").Range("$B$2:$D$4").FormulaR1C1 = "=Sheet(2)!RC" End Sub Sheet(3)をSheet3,Sheet(2)をSheet2 と書くとSheet3にSheet2の内容がコピーできます。 Sheet(3)のままだと、アプリケーションの定義またはオブジェクトの定義のエラーです。 と出ます。 Sheet(3)のままで、コピーできるようにする方法を教えてください。お願いします。

専門家に質問してみよう