質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.44%
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

Q&A

解決済

1回答

778閲覧

【VBA】マクロ動作中にシートを移動して見えるようにしたい

koburon

総合スコア30

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

0グッド

0クリップ

投稿2023/01/31 06:54

前提

VBAで任意の日付に入社、異動または退職した社員リストをCSV形式で出力するマクロを作っています。同じブック内で、シートは以下の3枚です。menuは下記のマクロを登録したボタンを配置するシートです。

  1. 異動DB
  2. 異動者リスト
  3. menu

該当のソースコード

CSVに出力するSubは別のモジュール内にありますが、実現したいことに直接関係ない為、ここでは省略します。(※回答に必要であれば追記します。)

VBA

1Sub idou() 2'異動者リストを作成する 3 4 Dim d As Date 5 Dim dval As String 6 Dim flag1 As Boolean 7 Dim flag2 As Boolean 8 Dim i As Long 9 Dim cnt As Long 10 Dim LastRow As Long 11 Dim rg As String 12 Dim sec As String 13 14 Dim strDateFormat As String 15 Dim wS1 As Worksheet 16 Dim wS2 As Worksheet 17 18 Dim rc As VbMsgBoxResult 19 20 'ワークシートを変数で宣言する 21 Set wS1 = Worksheets("異動DB") 22 Set wS2 = Worksheets("異動者リスト") 23 24 flag1 = False 25 flag2 = False 26 strDateFormat = wS1.Range("B2").NumberFormatLocal 27 28 '任意の日の異動者を抽出する 29 Application.ScreenUpdating = False 30 31 '区分を選ぶ 32 Do While flag1 = False 33 dval = InputBox("数値を入力してください(1:入社、2:異動、3:退職)(※半角数字)") 34 If StrPtr(dval) = 0 Then 35 'キャンセル又は右上の×をクリックした場合 36 Exit Sub 37 ElseIf dval = "" Then 38 'なにも入力しないでOKをクリックした場合 39 MsgBox ("何も入力されていません") 40 41 ElseIf dval = "1" Or dval = "2" Or dval = "3" Then 42 '入力値が正しい場合 43 sec = dval 44 flag1 = True 45 Else 46 '入力値が正しくない場合 47 MsgBox ("入力し直してください") 48 End If 49 Loop 50 51 '年月日を入力する 52 Do While flag2 = False 53 dval = InputBox("基準日を入力してください(記入例:1900/1/1)") 54 If StrPtr(dval) = 0 Then 55 'キャンセル又は右上の×をクリックした場合 56 Exit Sub 57 ElseIf dval = "" Then 58 'なにも入力しないでOKをクリックした場合 59 MsgBox ("何も入力されていません") 60 61 ElseIf IsDate(dval) = False Then 62 '入力日付が正しくない場合 63 MsgBox ("あり得ない日付です") 64 65 Else 66 '入力日付が正しい場合 67 '(必要があれば入力日付のチェックを行い、エラーなら再入力する) 68 d = CDate(dval) 69 flag2 = True 70 End If 71 Loop 72 73 '異動者リストで3行目以降をクリアする 74 wS2.Rows("3:" & Rows.Count).ClearContents 75 76 'オートフィルタで区分データを抽出する 77 '(抽出する区分は1:入社、2:異動、3:退職) 78 wS1.Range("A1").AutoFilter Field:=1, Criteria1:=sec 79 80 'オートフィルタで入力した日付を抽出する 81 wS1.Range("A1").AutoFilter Field:=2, Criteria1:=Format(d, strDateFormat) 82 83 'オートフィルタ結果の行数をカウントする 84 rg = "D1:D" & wS1.Range("D1").CurrentRegion.Rows.Count 85 cnt = WorksheetFunction.Subtotal(103, wS1.Range(rg)) 86 87 '1行のみの場合(見出し行のみ)終了する 88 If cnt = 1 Then 89 MsgBox ("該当する社員が存在しません") 90 91 'オートフィルタを解除 92 wS1.Range("A1").AutoFilter 93 wS1.Range("B1").AutoFilter 94 95 Exit Sub 96 End If 97 98 '抽出した社員番号をコピーして貼り付ける 99 LastRow = wS1.Cells(Rows.Count, "D").End(xlUp).Row 100 wS1.Range("D1").CurrentRegion.Range("D1").Offset(1, 0).Resize(LastRow - 1, 1).Copy wS2.Range("A3") 101 102 '異動者リストにコピー貼り付け 103 Call Copy 104 105 '異動者リストをCSVで出力 106 rc = MsgBox("該当社員情報をCSVで出力しますか?", vbYesNo + vbQuestion) 107 If rc = vbYes Then 108 '「はい」をクリックした場合 109 Call Module6.CSV出力 110 111 Else 112 '「いいえ」をクリックした場合 113 Exit Sub 114 115 End If 116 117 Application.ScreenUpdating = True 118 119End Sub

実現したいこと

このマクロの動作中、画面は【menu】のままです。

  • (103行目)【異動者リスト】に抽出結果を貼り付けた時
  • (106行目)メッセージボックスを表示させる時

この間のタイミングで、【異動者リスト】に移動させたいです。
抽出結果が正しいかユーザーに確認してもらうのが目的です。

試したこと・発生している問題

シンプルに103行目と106行目の間にActivateを入れればいいだろう、と思い、入れてみたのですが、【異動DB】が真っ白なままで移動されませんでした。メッセージボックス自体は問題なく動作しました。

wS2.Activate

Application.ScreenUpdatingの内部だと動作しないのかな、とも思いましたが原因がよく分からないです。原因が分かる方、解決策をご教示いただければ幸いです。よろしくお願いいたします。

補足情報(FW/ツールのバージョンなど)

PC:Windows11
ソフト:Microsoft365 Excel
参考URL:エクセルの学校

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

pig_vba

2023/01/31 07:13

ScreenUpdating = Falseしてるからですね。 ScreenUpdating = True DoEvents ScreenUpdating = False を試してみてください
koburon

2023/01/31 07:24

>pig_vba様 コメントありがとうございます。 間のDoEventsの位置ですが、 ScreenUpdating = True の直下でよろしいでしょうか。
pig_vba

2023/01/31 07:28

直下です。activateのかわりに3つセットで入れる感じです 内容としては 一旦再描画オンにしてDoEventsだけして即オフにするって感じです。弊環境ではこれで再描画できてるので多分大丈夫です
koburon

2023/01/31 08:06

>pig_vba様 コメントありがとうございます。 103行目と106行目の間に3文をこの通りの並びで入れて実行しましたが、シートが移動されませんでした。 ただ入れるだけではダメで、29行目のScreenUpdatingのように他のコードも修正が必要なのでしょうか。
pig_vba

2023/02/01 00:06 編集

あ、すみません。単純に最新の状態を確認したいだけ(アクティブシートは変化していない)であると解釈してました。 それであればDoEventsの直前にSheet.activateも一緒に入れてください 再描画オン→シート移動→DoEvents→再描画オフの順です
koburon

2023/02/01 00:31

>pig_vba様 コメントありがとうございます。 ご指摘の通り4つの文で入力して実行したところ、要望通り、シートを移動させることができました。 ベストアンサーとさせていただきたいのですが、回答ではないので、自己解決に記入して締め切らせていただきます。 ありがとうございました。
guest

回答1

0

自己解決

いただいたコメントに倣って、106行目の前に以下のコードを追加すると、要望通り、シートを移動させることができました。

'画面更新を再開して異動者リストに移動 Application.ScreenUpdating = True wS2.Activate DoEvents Application.ScreenUpdating = False

投稿2023/02/01 00:34

編集2023/02/01 00:35
koburon

総合スコア30

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.44%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問