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

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

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

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

Q&A

3回答

12391閲覧

マクロ実行中のセル入力について

kkgw

総合スコア49

VBA

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

0グッド

3クリップ

投稿2016/07/18 06:27

編集2022/01/12 10:55

excelvbaでマクロ実行中に
セルに入力をするとマクロがとまってしまいます。
マクロの内容としては、セルの順番にアクティベートにして、
そのセルに入力を出来るようにしたいと思っています。
入力する時間を10秒間作るために、ループを下記のように書いております。

dblTimer = Timer
Do Until Int(Timer - dblTimer) = 11
this_sheet.Cells(2, 6) = Int((Timer - dblTimer))
DoEvents
Loop

11秒になった時にループを抜ける実装にしています。
この時に、セルに入力をするとマクロがとまってしまいます。
エラーメッセージは、
”実行時エラー1004”(アプリケーション定義またはオブジェクト定義のエラーです)
になります。

ネットで色々調べましたが、分かりませんでした。
お分かりになる方いらっしゃいましたら、教えて頂けると大変ありがたいです。
私としては、
宜しくお願い致します。
下記、全体のコードです。

'''lang-excelvba

Sub test_マトリクス順次入力()

ReDim Files_1(0)
ReDim Files_2(0)

Dim this_book As Workbook
Dim this_sheet As Worksheet

Set this_book = Workbooks("自動マクロトレーニング.xlsm")
Set this_sheet = this_book.Worksheets("マトリクス順次入力")

Dim i As Long
i = 3
Do Until Cells(i, 3) = ""
n = UBound(Files_1)
ReDim Preserve Files_1(n + 1)
Files_1(n + 1) = Cells(i, 3)
i = i + 1
Loop

Dim j As Long
j = 3

Do Until Cells(j, 4) = ""
m = UBound(Files_2)
ReDim Preserve Files_2(m + 1)
Files_2(m + 1) = Cells(j, 4)
j = j + 1
Loop

For k = 1 To UBound(Files_1)
this_sheet.Cells(k + 2, 6) = Files_1(k)
Next

For l = 1 To UBound(Files_2)
this_sheet.Cells(2, 6 + l) = Files_2(l)
Next

For k = 1 To UBound(Files_1)
For l = 1 To UBound(Files_2)
this_sheet.Cells(2 + k, 6 + l).Activate
dblTimer = Timer
Do Until Int(Timer - dblTimer) = 11
this_sheet.Cells(2, 6) = Int((Timer - dblTimer))
DoEvents
Loop
Next
Next

End Sub

'''

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

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

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

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

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

Zuishin

2016/07/18 06:54

読みにくくないですか? インデントが無くなっていますので、コード領域内に書いてください。 再度編集して、プレビューを見ながら読みやすくなるようマークダウンを使ってください。
Zuishin

2016/07/18 09:31

''' ではなく ‘‘‘ です。編集画面の上の方に </> のようなボタンがありますので、それをお使いください。
guest

回答3

0

そもそもの話になってしまい恐縮ですが、セルの順番にアクティベートする操作を、本当にマクロで自動化しなければいけないのでしょうか。

マトリクスを作成した後、入力領域を範囲選択し(←ここが大事です)、入力→TAB押下→入力...と操作を繰り返していけば、普通に順番に入力できると思います。

追記:
不要とは思いましたが、念のためアクティベートを自動で行う処理を追加しました。
仕組みとしては、マクロの最後で10秒に1回TABキーを押下するPowerShellコマンドを実行しています。
入力領域が範囲選択されていることが前提となりますので、方向キーなどで範囲選択を解除しないようにご注意下さい。

質問者様のVBAコードを一部修正したものも載せておきます。
(修正したのは最後の処理のみで、あとはインデントを付けただけです)

VBA

1Sub test_マトリクス順次入力() 2 ReDim Files_1(0) 3 ReDim Files_2(0) 4 5 Dim this_book As Workbook 6 Dim this_sheet As Worksheet 7 8 Set this_book = Workbooks("自動マクロトレーニング.xlsm") 9 Set this_sheet = this_book.Worksheets("マトリクス順次入力") 10 11 Dim i As Long 12 i = 3 13 14 Do Until Cells(i, 3) = "" 15 n = UBound(Files_1) 16 ReDim Preserve Files_1(n + 1) 17 Files_1(n + 1) = Cells(i, 3) 18 i = i + 1 19 Loop 20 21 Dim j As Long 22 j = 3 23 24 Do Until Cells(j, 4) = "" 25 m = UBound(Files_2) 26 ReDim Preserve Files_2(m + 1) 27 Files_2(m + 1) = Cells(j, 4) 28 j = j + 1 29 Loop 30 31 For k = 1 To UBound(Files_1) 32 this_sheet.Cells(k + 2, 6) = Files_1(k) 33 Next 34 35 For l = 1 To UBound(Files_2) 36 this_sheet.Cells(2, 6 + l) = Files_2(l) 37 Next 38 39 '入力領域を範囲選択 40 this_sheet.Activate 41 this_sheet.Range(Cells(2 + 1, 6 + 1), Cells(2 + UBound(Files_1), 6 + UBound(Files_2))).Select 42 43 '自動アクティベート 44 Call 連続キー押下("{TAB}", UBound(Files_1) * UBound(Files_2)) 45End Sub 46 47Sub 連続キー押下(ByVal keyString As String, ByVal cnt As Long, Optional ByVal interval As Integer = 10) 48 Dim command As String 49 command = "" 50 51 'PowerShellコマンド生成 52 ' 初期処理 53 command = command & "[void][Reflection.Assembly]::LoadWithPartialName('System.Windows.Forms');" 54 command = command & "$keyString='" & keyString & "';" 55 command = command & "$cnt=" & cnt & ";" 56 command = command & "$interval=" & interval & ";" 57 58 ' PowerShellウィンドウが表示されフォーカスが移るため、Alt+Tab押下でExcelにフォーカスを戻す 59 command = command & "[System.Windows.Forms.SendKeys]::SendWait('%{TAB}');" 60 61 ' 連続キー押下 62 command = command & "for($i=0;$i -lt $cnt;$i++){" 63 command = command & " sleep -s $interval;" 64 command = command & " [System.Windows.Forms.SendKeys]::SendWait($keyString);" 65 command = command & "}" 66 67 'PowerShellコマンド実行 68 Call CreateObject("Wscript.Shell").Exec("powershell -command """ & command & """") 69End Sub

投稿2016/08/12 06:54

編集2016/08/12 09:00
minr

総合スコア37

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

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

0

案1

Application.OnTimeで所定時間経過後に関数の呼び出しができますがいかがでしょうか?

※使い方は以下のサイトが参考になります。
⇒すぐに役立つExcelVBAマクロ集

Sub prcTimer() Dim iRow As Integer 'とりあえずB2セルを出力行番号として処理しています。 iRow = Val(Cells(1, 2)) Dim tNextTime iRow = iRow + 1 Cells(1, 2) = iRow If iRow > 10 Then '10行書いたら終了 Cells(1, 2) = 0 MsgBox "終了" Exit Sub End If Cells(iRow, 1).Activate '所定時間(ここでは3秒後)になったら再度この関数を呼び出すようタイマーセット tNextTime = TimeValue(Now) + TimeValue("00:00:03") Application.OnTime tNextTime, "prcTimer" End Sub

ただ、この方法ではセルの入力中に指定時間を迎えた場合、入力が終わるのを待ってから次の処理が発生となります。
このため、セル入力中でも強制的に次のセルに移動するようなことはできません。

案2

別案として、Inputboxのようなテキスト入力用のフォームを表示し、値を入力させる方法を提案してみます。
テキスト入力フォームを表示して、そのフォームで入力した値をセルにも反映させていくような形です。
フォーム表示後、所定の時間が経過したら強制的にフォームを終了し、次の項目のテキスト入力用フォームとして開き直すような流れになると思います。

入力方法がだいぶ変わってしまうのでだめかもしれませんが、案として参考までに。
ちなみにタイマー処理自体は案1と同じApplication.OnTimeです。

(標準モジュールに記述するコード)

'テキスト入力用フォームの起動処理 Sub Start() 'とりあえずB2セルに出力行番号を格納して終了判定 If Cells(1, 2) > 10 Then '10行書いたら終了 Cells(1, 2) = 0 Exit Sub End If 'テキスト入力用フォームを表示 UserForm1.Show End Sub '所定時間後に行う処理 Sub SetVal() 'B2セルから出力行番号を取得 Dim iRow As Integer iRow = Val(Cells(1, 2)) Dim tNextTime 'B2セルに出力行番号を格納 iRow = iRow + 1 Cells(1, 2) = iRow 'テキスト入力用フォームでの入力値をセルに反映 Cells(iRow, 1) = UserForm1.TextBox1 'テキスト入力用フォームの終了 Unload UserForm1 'テキスト入力用フォームを起動 Start End Sub

(ユーザーフォームに記述するコード)

'フォーム起動時の処理 Private Sub UserForm_Initialize() Dim tNextTime '所定時間(ここでは3秒後)になったらSetVal関数を呼び出すようタイマーセット tNextTime = TimeValue(Now) + TimeValue("00:00:03") Application.OnTime tNextTime, "SetVal" End Sub

投稿2016/07/19 08:17

jawa

総合スコア3013

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

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

kkgw

2016/07/19 16:14

ご指摘ありがとうございました。 ちょっとすぐには、理解出来ないので、読んで理解してから また、後日コメントさせて頂きます。
jawa

2016/07/20 03:05

すこし補足します。 Application.OnTimeは指定時間になったら指定した関数を実行する命令です。 サンプルコードでは、現在時刻から3秒後に指定した関数を呼び出すようになっています。 呼び出された関数は、最後にまた現在時刻から3秒後にタイマーをセットしているので、3秒毎に繰り返し関数が呼び出される仕組みです。 --- このApplication.OnTimeは、融通が利かない部分があります。 それが、セル編集中(セルの中にIカーソルが表示されているような状態)に割り込んでまで処理してはくれないところです。 つまり、タイマーセット後にセルを入力し始めると、ENTERやTABキーなどでそのセルの入力を抜けるまでは10分でも1時間でも待ってしまいます。 (入力が終わった後に指定の関数が呼び出される) 今回、10秒で次のセルをアクティブにするようですが、これが自動的に次のセルに移動してあげる「入力支援」の目的であれば問題ないかもしれません。 もし時間内に回答させるような「入力制限」が目的だとしたら、割り込み処理にならないのは問題ありだと思います。 --- セルに入力させると入力中はApplication.OnTimeが割り込まないので、その点を何とかしようとしたのが別案です。 セルに入力させるのではなく、テキストボックスを持つ入力フォームを作成し、そこで入力させよう、ということです。 サンプルコードではこのフォームの起動時に、3秒後にフォームを閉じる関数を呼び出すようタイマー設定しています。 フォームを閉じる関数では、フォームを閉じた後に新たにフォームの起動もしている為、3秒毎に入力フォームが再起動される仕組みになっています。 セルを編集中にしないため、入力途中でも強制的に打ち切られ、次の入力に移ります。
guest

0

EXCEL-VBAはシングルスレッドでしか動かないので、タイマーで制御するような使い方は困難です。
例えば、
・別のEXCELプロセスを起動して、その別プロセスから10秒毎に元のプロセスのプロシージャをコールする。
など一工夫必要になります。

以下追記しました。
--timer.xlsmの標準モジュール--

lang

1Option Explicit 2 3Dim TARGET_APP As Application 4Dim TARGET_BOOK As Workbook 5 6Public Sub SetTarget(bookName As String) 7 Set TARGET_BOOK = GetObject(bookName) 8 Set TARGET_APP = TARGET_BOOK.Application 9End Sub 10 11Public Sub StartTimer(procedureName As String, numOfTimes As Long, waitingTime As Long) 12 13 Dim myTime As Date 14 myTime = Now() 15 16 Dim count As Long 17 For count = 0 To numOfTimes 18 Application.Wait TimeSerial(Hour(myTime), Minute(myTime), Second(myTime) + waitingTime * count) 19    TARGET_APP.Run procedureName 20 Next count 21 22End Sub

--TextBook.xlsmの標準モジュール--

lang

1Option Explicit 2Dim TIMER_BOOK As Workbook 3Const TIMER_BOOK_FILENAME = "D:\timer.xlsm" 4 5Public Sub Test() 6 Dim fso As Object 7 Set fso = CreateObject("Scripting.FileSystemObject") 8 9 Dim tmpFileName As String 10 tmpFileName = fso.GetSpecialFolder(2) & "\" & fso.GetBaseName(fso.GetTempName) & ".xlsm" 11 12 FileCopy TIMER_BOOK_FILENAME, tmpFileName 13 14 Dim otherApp As Application 15 Set otherApp = New Application 16 17 Set TIMER_BOOK = otherApp.Workbooks.Open(tmpFileName) 18 With TIMER_BOOK.Application 19 .Run "SetTarget", ThisWorkbook.FullName 20 .Run "StartTimer", "MoveNext", 10, 10 21 End With 22 23End Sub 24 25Public Sub End_Test() 26 If (Not TIMER_BOOK Is Nothing) Then 27 Dim bookName As String 28 bookName = TIMER_BOOK.FullName 29 TIMER_BOOK.Application.Quit 30 Kill bookName 31 End If 32End Sub 33 34Public Sub MoveNext() 35 '省略 36End Sub

投稿2016/07/18 08:19

編集2016/07/21 09:17
hihijiji

総合スコア4150

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

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

kkgw

2016/07/18 08:28

ありがとうございます。 "別のEXCELプロセスを起動して"という事は、マクロが書いてあるブックとは別のブックを立ち上げて、そこにコードを書いて、そこから操作を行う、という理解で宜しかったでしょうか? ちょっと難しそうですが、トライしてみます。大変にありがとうございました。
hihijiji

2016/07/18 09:01

はい。 タイマー機能を別プロセスに出来ればEXCEL-VBA以外でもOKです。 もう一つ、コードの注意事項として 「Cells(i, 3) = ""」のCellsのようにインスタンスが特定できない書き方は、トラブルの元になりますので避けてください。
kkgw

2016/07/19 16:12

様々ご指摘ありがとうございました。 別ブックのマクロから呼び出しをしてら、自分の希望通り、 セルに入力してもマクロが止まらないで進むようになりました。 大変に嬉しいです。 ただ、現状、出力したいブックとは違うブックを画面に表示すると、エラーで止まって しまったり、セル(1,1)から出力されるはずなのに、セル(3,3)から出力されたりするという不思議な現象が起こっていますが、とりあえず、これを応用すれば、自分の要求は満たせそうな気がします。 以下のようなコードで、book1のプロシージャでbook2のプロシージャを呼び出して、 3秒毎に、セルに"1"を順番に入力するという実装が出来ました。 また、ご指摘があれば是非お願い致します。 ---Book1.xlsmの標準モジュール内--- Sub test_1() For j = 1 To 30 dblTimer = Timer Do Until Int(Timer - dblTimer) = 3 DoEvents Loop Application.Run "Book2.xlsm!test_2" Next End Sub ---Book2.xlsmの標準モジュール内--- Sub test_2() Dim this_book As Workbook Set this_book = Workbooks("Book2.xlsm") Dim this_sheet As Worksheet Set this_sheet = Worksheets("test") Static i As Long i = i + 1 this_sheet.Cells(i, i) = 1 End Sub
hihijiji

2016/07/21 09:00 編集

追記のような感じで、タイマーを作って利用する方法を考えましたが、 jawaさんのようにApplication.OnTimeを使ったほうがよさそうですね。 EXCEL-VBAによるマルチプロセスのサンプルとして一応書いておきます。
guest

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

まだベストアンサーが選ばれていません

会員登録して回答してみよう

アカウントをお持ちの方は

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

ただいまの回答率
85.50%

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

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

質問する

関連した質問