Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
917 / 13645 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【77559】マクロ実行後に「応答なし」 viaggio 15/10/22(木) 16:33 質問[未読]
【77562】Re:マクロ実行後に「応答なし」 ウッシ 15/10/23(金) 14:36 回答[未読]
【77563】Re:マクロ実行後に「応答なし」 viaggio 15/10/23(金) 14:53 お礼[未読]
【77559】マクロ実行後に「応答なし」
質問  viaggio  - 15/10/22(木) 16:33 -
引用なし
パスワード
   作成したマクロを実行し問題なく処理完了はするのですが、
その後、しばらく(1〜2分ほど)「応答なし」となり動作が止まります。
同一ファイルでも、同じような現象が起きるマクロと起きないマクロがあります。
原因や解決策、わかりましたら教えてください。
現象が起きるマクロの一例↓
------------------------------------------------------------
Sub 選択した項目の前回登録情報をコピー()

Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

bName = Excel.ActiveWorkbook.Name
sName = Excel.ActiveSheet.Name

S_R = Selection(1).Row
E_R = Selection(Selection.Count).Row
S_C = Selection(1).Column
E_C = Selection(Selection.Count).Column

rc = MsgBox("選択しているセルの内容を、前回登録時の情報に書き換えます。" & (Chr(10) & Chr(13)) & _
"この機能はセルの位置が完全一致している時のみ使用できます。" & (Chr(10) & Chr(13)) & _
"よろしければ[OK]を押下してください。", vbOKCancel + vbQuestion, "※要注意※")
　　
　　　　If rc = vbOK Then
　　　　
　　　　　GoTo LABEL_1
　　　　　　
　　　　　　Else
　　　　　
　　　　　MsgBox "処理を中断します"
　　　　　Exit Sub
　　　　　End If

LABEL_1:
　　
　　Windows("151022_同一再稼働支援ツール.xlsm").Activate
　　Worksheets("登録票").Activate
　　Range(Cells(S_R, S_C), Cells(E_R, E_C)).Select

　　Selection.Copy
　　Windows(bName).Activate
　　Worksheets(sName).Activate
　　Range(Cells(S_R, S_C), Cells(E_R, E_C)).Select
　　
　　Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
　　　　xlNone, SkipBlanks:=False, Transpose:=False
　　　　
　　　　Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub
【77562】Re:マクロ実行後に「応答なし」
回答  ウッシ  - 15/10/23(金) 14:36 -
引用なし
パスワード
   こんにちは

原因は分かりませんが、コードの書き方で、変数の宣言を強制するように
ツール、オプションで設定しておきましょう。

Option Explicit

Sub 選択した項目の前回登録情報をコピー()
　　Dim mSh As Worksheet
　　Dim sR　As Range
　　Dim m　 As String
　　Dim rc　As Variant
　　Dim tSh As Worksheet
　　
　　On Error Resume Next
　　Set tSh = Workbooks("151022_同一再稼働支援ツール.xlsm") _
　　　　　　　　.Worksheets("登録票")
　　On Error GoTo 0
　　
　　If tSh Is Nothing Then
　　　　MsgBox "151022_同一再稼働支援ツール.xlsmが開かれていないか、" & _
　　　　　　　　(Chr(10) & Chr(13)) & _
　　　　　　　　"登録票シートが存在しません。" & _
　　　　　　　　(Chr(10) & Chr(13)) & _
　　　　　　　　"処理を中断します"
　　　　Exit Sub
　　End If
　　
　　Set mSh = ActiveWorkbook.ActiveSheet
　　Set sR = Selection
　　　　
　　m = "選択しているセルの内容を、前回登録時の情報に書き換えます。"
　　m = m & (Chr(10) & Chr(13))
　　m = m & "この機能はセルの位置が完全一致している時のみ使用できます。"
　　m = m & (Chr(10) & Chr(13))
　　m = m & "よろしければ[OK]を押下してください。"
　　
　　rc = MsgBox(m, vbOKCancel + vbQuestion, "※要注意※")
　
　　If rc = vbOK Then
　　　　Workbooks("151022_同一再稼働支援ツール.xlsm") _
　　　　　　.Worksheets("登録票").Range(sR.Address).Copy sR
　　Else
　　　　MsgBox "処理を中断します"
　　End If
　　
　　Application.Calculation = xlCalculationAutomatic
　　Application.ScreenUpdating = True
　　Application.EnableEvents = True

End Sub

インデントを付けてコードを見やすく。

　　Application.EnableEvents = True

としてあると言う事はチェンジイベントがあるのですか？

　　Application.Calculation = xlCalculationAutomatic

の計算実行との順序は大丈夫ですか？
【77563】Re:マクロ実行後に「応答なし」
お礼  viaggio  - 15/10/23(金) 14:53 -
引用なし
パスワード
   ＞ウッシ様　

回答ありがとうございます。

ＶＢＡの知識もないまま、既存のものを切り貼りして
作っているので、よく意味も理解できませんが、

このまま使わせていただきましたら、
早くなりました。

今後、こちらを参考にさせて頂きたいと思います。

ありがとうございました。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
917 / 13645 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free