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

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

ただいまの
回答率

89.99%

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

受付中

回答 3

投稿 編集

  • 評価
  • クリップ 3
  • VIEW 5,571

KakegawaKouiti

score 22

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

'''

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

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

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

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

質問への追記・修正、ベストアンサー選択の依頼

  • Zuishin

    2016/07/18 15:54

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

    キャンセル

  • Zuishin

    2016/07/18 18:31

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

    キャンセル

回答 3

0

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

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

Option Explicit

Dim TARGET_APP As Application
Dim TARGET_BOOK As Workbook

Public Sub SetTarget(bookName As String)
    Set TARGET_BOOK = GetObject(bookName)
    Set TARGET_APP = TARGET_BOOK.Application
End Sub

Public Sub StartTimer(procedureName As String, numOfTimes As Long, waitingTime As Long)

    Dim myTime As Date
    myTime = Now()

    Dim count As Long
    For count = 0 To numOfTimes
        Application.Wait TimeSerial(Hour(myTime), Minute(myTime), Second(myTime) + waitingTime * count)
    TARGET_APP.Run procedureName
    Next count

End Sub

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

Option Explicit
Dim TIMER_BOOK As Workbook
Const TIMER_BOOK_FILENAME = "D:\timer.xlsm"

Public Sub Test()
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")

    Dim tmpFileName As String
    tmpFileName = fso.GetSpecialFolder(2) & "\" & fso.GetBaseName(fso.GetTempName) & ".xlsm"

    FileCopy TIMER_BOOK_FILENAME, tmpFileName

    Dim otherApp As Application
    Set otherApp = New Application

    Set TIMER_BOOK = otherApp.Workbooks.Open(tmpFileName)
    With TIMER_BOOK.Application
        .Run "SetTarget", ThisWorkbook.FullName
        .Run "StartTimer", "MoveNext", 10, 10
    End With

End Sub

Public Sub End_Test()
    If (Not TIMER_BOOK Is Nothing) Then
        Dim bookName As String
        bookName = TIMER_BOOK.FullName
        TIMER_BOOK.Application.Quit
        Kill bookName
    End If
End Sub

Public Sub MoveNext()
    '省略
End Sub

投稿

編集

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2016/07/18 17:28

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

    キャンセル

  • 2016/07/18 18:01

    はい。
    タイマー機能を別プロセスに出来ればEXCEL-VBA以外でもOKです。

    もう一つ、コードの注意事項として 「Cells(i, 3) = ""」のCellsのようにインスタンスが特定できない書き方は、トラブルの元になりますので避けてください。

    キャンセル

  • 2016/07/20 01: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

    キャンセル

  • 2016/07/21 17:44 編集

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

    キャンセル

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/20 01:14

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

    キャンセル

  • 2016/07/20 12:05

    すこし補足します。
    Application.OnTimeは指定時間になったら指定した関数を実行する命令です。

    サンプルコードでは、現在時刻から3秒後に指定した関数を呼び出すようになっています。
    呼び出された関数は、最後にまた現在時刻から3秒後にタイマーをセットしているので、3秒毎に繰り返し関数が呼び出される仕組みです。

    ---
    このApplication.OnTimeは、融通が利かない部分があります。
    それが、セル編集中(セルの中にIカーソルが表示されているような状態)に割り込んでまで処理してはくれないところです。

    つまり、タイマーセット後にセルを入力し始めると、ENTERやTABキーなどでそのセルの入力を抜けるまでは10分でも1時間でも待ってしまいます。
    (入力が終わった後に指定の関数が呼び出される)

    今回、10秒で次のセルをアクティブにするようですが、これが自動的に次のセルに移動してあげる「入力支援」の目的であれば問題ないかもしれません。
    もし時間内に回答させるような「入力制限」が目的だとしたら、割り込み処理にならないのは問題ありだと思います。

    ---
    セルに入力させると入力中はApplication.OnTimeが割り込まないので、その点を何とかしようとしたのが別案です。

    セルに入力させるのではなく、テキストボックスを持つ入力フォームを作成し、そこで入力させよう、ということです。

    サンプルコードではこのフォームの起動時に、3秒後にフォームを閉じる関数を呼び出すようタイマー設定しています。
    フォームを閉じる関数では、フォームを閉じた後に新たにフォームの起動もしている為、3秒毎に入力フォームが再起動される仕組みになっています。

    セルを編集中にしないため、入力途中でも強制的に打ち切られ、次の入力に移ります。

    キャンセル

0

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

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

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

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

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

  '入力領域を範囲選択
  this_sheet.Activate
  this_sheet.Range(Cells(2 + 1, 6 + 1), Cells(2 + UBound(Files_1), 6 + UBound(Files_2))).Select

  '自動アクティベート
  Call 連続キー押下("{TAB}", UBound(Files_1) * UBound(Files_2))
End Sub

Sub 連続キー押下(ByVal keyString As String, ByVal cnt As Long, Optional ByVal interval As Integer = 10)
  Dim command As String
  command = ""

  'PowerShellコマンド生成
  '  初期処理
  command = command & "[void][Reflection.Assembly]::LoadWithPartialName('System.Windows.Forms');"
  command = command & "$keyString='" & keyString & "';"
  command = command & "$cnt=" & cnt & ";"
  command = command & "$interval=" & interval & ";"

  '  PowerShellウィンドウが表示されフォーカスが移るため、Alt+Tab押下でExcelにフォーカスを戻す
  command = command & "[System.Windows.Forms.SendKeys]::SendWait('%{TAB}');"

  '  連続キー押下
  command = command & "for($i=0;$i -lt $cnt;$i++){"
  command = command & "  sleep -s $interval;"
  command = command & "  [System.Windows.Forms.SendKeys]::SendWait($keyString);"
  command = command & "}"

  'PowerShellコマンド実行
  Call CreateObject("Wscript.Shell").Exec("powershell -command """ & command & """")
End Sub

投稿

編集

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

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

  • ただいまの回答率 89.99%
  • 質問をまとめることで、思考を整理して素早く解決
  • テンプレート機能で、簡単に質問をまとめられる

同じタグがついた質問を見る