• ベストアンサー

VBAのプログラムが動いているかどうか分かるようにするには？

yuu_yuuの回答

  • ベストアンサー
  • yuu_yuu
  • ベストアンサー率41% (34/81)
回答No.1

全体の量がわからないけど、死んでないことを確認するために昔よく使ったのが、 カウンタを作ってインクリメントをしてき、カウンタを４で割った余りが ０の場合”／”を表示。１の場合”－”を表示。２の場合”＼”を表示。 ３の場合”｜”を表示して、棒がクルクル回っていることで、プログラムが 死んでいないことを確認しました。 重い処理をさせながら、何かを描画したい場合は、OSに制御をいったん返すことも お忘れなく。（Doeventだったかな。。。失念＾＾；）

komarimono
質問者

お礼

ありがとうございました

この回答がついた質問に戻る
回答 全件
UserFormを作り、vbModelessで表示するのが一番簡単だと…
  1. カテゴリ
  2. [技術者向] コンピューター
  3. プログラミング・開発
  4. Visual Basic

関連するQ&A

  • (;゜д゜)ユーザーフォームでプログレスバーを使いたいが・・・存在していない！！(;゜д゜)

    お世話になっております。 プログレスバーについて教えて下さい。 ユーザーフォームを使いそこにプログレスバーが配置できるとネット上で調べたので使おうと思いました。 ところが・・・ツールボックスにプログレスバーがありません(;゜д゜)ァ.... 探してみたのですがどこにも見つかりません。エクセルが壊れているのでしょうか？ また、プログレスバーについてどういう風にやったらできるのかというのを見ていたのですがどう動いているのか理解力が無いため理解が出来ません・・・ 下記のようなコードがあり作動している間はバーを動かしたいのですがどうしたらいいでしょうか・・・ Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) Dim r As Range For Each r In Target MyProc r Next End Sub Sub MyProc(Target As Range) ・ ・ ・ ・ ・ End Sub

  • Excel2010 VBA 条件色付け

    Sub sample() Dim r As Range For Each r In Range("q6:q30") If myIsNumeric(r) Then r.Offset(0, 1).Value = "数字" Else r.Offset(0, 1).Value = "文字" End If Next End Sub Function myIsNumeric(Target As Range) Dim r As Range Dim buf, tmp Dim flg As Boolean Dim i As Integer buf = Target For i = 1 To Len(buf) tmp = Mid(buf, i, 1) If IsNumeric(tmp) Then flg = True Exit For End If Next myIsNumeric = flg End Function を数字が入ってたら塗りつぶさないで、 数字が入ってなかったら塗りつぶすように直したいです。 あああ→塗る あああ1－1→塗らない 住所→塗る 住所12→塗らない

  • 教えて For Each R In Target

    いつもお世話になっております よろしくお願いします ネットで見つけたマクロなのですが、どなたか解説していただけないでしょうか Private Sub Worksheet_Change(ByVal Target As Range) 　Dim R As Range For Each R In Target With R 条件判断と処理 End With Next R End Sub

  • イベントを起こすと画面が揺れまくって大変です・・・結構見栄えもきついので回避できないでしょうか？

    以前ワークシートのイベントのプログラムを教えていただきありがとうございました。 参考に作ったプログラムなのですが・・・範囲をもう少しだけでかくしてやると画面がゆれて困っています。 値を入れてコピーしているときが特にひどいです。 複数セルを選択して消去しても大丈夫なようにかつ揺れない方法はないでしょうか？ Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) Dim r As Range For Each r In Target MyProc r Next End Sub Sub MyProc(Target As Range) Dim i As Long Application.EnableEvents = False If Selection.Cells.Count <> 1 Then Exit Sub ' 変更したセルに値が入った場合条件成立 If Trim(Target.Value) <> "" Then ' 行番号が10以上65530以内のとき条件成立 If Target.Row >= 10 And Target.Row <= 65530 Then ' BCD列で、5の倍数の行のとき条件成立 If (Target.Column >= 2) And (Target.Column <= 4) Then If (Target.Row Mod 5) = 0 Then If Target.Value <> "" Then For i = 0 To 4 Target.Copy Target.Offset(i, 10).PasteSpecial Paste:=xlPasteValues Next If (Target.Column = 2) Then Worksheets("Sheet4").Range("A2:K6").Copy Target.Offset(5, -1) End If End If Else Exit Sub End If End If End If Application.CutCopyMode = False End If Application.EnableEvents = True End Sub

  • VBA：Callステートメントでいつでもイベント発生可能な準備をしたい。

    タイトルどおり、Callステートメントでいつでもイベント発生可能な準備ができるようにしたいと考えています。しかし、Sub 実行準備SUBでエラーが出ています。どこをどう直せばよいのか教えて頂きたいです。 Private Sub Auto_Open() MsgBox "Ctrl + t でイベント実行準備を行います。" Application.OnKey "^{t}", "実行準備SUB" End Sub '--------------------------------------------------- Sub 実行準備SUB() Dim Target As Range Target = Range(Cells(1, 1), Cells(100, 100)) Call Worksheet_Change(ByVal Target) End Sub '--------------------------------------------------- Private Sub Worksheet_Change(ByVal Target As Excel.Range) Dim r As Range For Each r In Target If r.Column = 2 Then r.Offset(0, -1).Value = Now End If Next r End Sub イベントは、シートの2列目のセルに変更があれば、1列目に日付時刻を記入するというものです。宜しくお願い致します。

  • マクロで列を挿入してふりがなをふる

    全てのシートにあるA列にはいっている漢字を左側に 列を挿入してそこにふりがなをふりたく、 素人なりに下記のソースを書いたんですが、 わけわからんところに挿入されるは無茶苦茶になってしまいました。 どなたか添削していただけないでしょうか？ Sub フリガナ挿入() Dim ws As Worksheet Dim r As Range For Each ws In Worksheets For Each r In Range("A1", Range("A65536").End(xlUp)) Columns("A").Insert Shift:=xlShiftToLeft Range("A1" & r.Row).Value = Application.GetPhonetic(r) Next Next End Sub

  • VBAですべてのワークシートを処理したい

    ブック内の全ワークシートに対して同じ処理をするために、 For each ワークシート in Worksheets ～処理～ Next ワークシート を使ってみたのですが、その時にアクティブになっているシートしか処理されません。たとえば次のようなシンプルなコードでも、同様です。何が抜けているのでしょうか。 Sub allworksheets() Dim WS As Worksheet For Each WS In Worksheets Range("a1") = "123" Next WS End Sub マクロの勉強を始めたばかりで、基本的なことでつまづいてます。よろしくお願い致します。

  • エクセルVBAにてプログラムされているシートに別のシートからマクロのモジュールにて貼り付けるとエラーになります。

    エクセルVBAにてプログラムされているシートに別のシートからマクロのモジュールにて普通のデータを貼り付けるとエラーになります。 何卒エラーの解除方法を教えて下さい。 また、合わせて下記プログラムは四角形等のオートシェイプの書式に対応していますが、 同じシート上に写真等の図の書式があるとエラーになります。 お手数ですが、解決方法を教えて下さい。 Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim C As Variant Dim i As Integer Dim Rng As Range For Each Rng In Target If Not Intersect(Range("e36:i40"), Rng) Is Nothing Then Select Case Rng.Row Case 36 C = Split("3 0 0 0 0") Case 37 C = Split("0 3 0 0 0") Case 38 C = Split("0 0 3 0 0") Case 39 C = Split("0 0 0 3 0") Case 40 C = Split("0 0 0 0 3") End Select Else C = Split("0 0 0 0 0") End If For i = 0 To 4 ActiveSheet.Shapes(i + 1).Select Selection.Font.ColorIndex = C(i) Next i Next Rng Target.Select End Sub

  • VBAで教えて下さい。

    VBA初心者です。始めてから２，３週間です。 表を作りたいのですが、 顧客名のシートを１００枚ほど作り、シート１（シート１は検索シートにしたいので顧客名は無）のA1にクライアント名を入力したら入力した顧客名シートが出てくる様にしたいです。 参考書、ネット等をみて作成しましたがエラーが出ます。作動するにはどの様にしたら宜しいでしょうか？どうかお助け下さい。宜しくお願い致します。コードは下記です。 Private Sub Worksheet_Change(ByVal Target As Range) Dim i As Integer Dim myWSname As String, myworksheet As Worksheet myWSname = "i" myWSname = Worksheets("sheet2").Range("A1").Value For Each myworksheet In Worksheets If myworksheet.Name = mayWSname Then Worksheets("myWSname").Activate Exit Sub End If Next myworksheet End Sub

  • VBA　シートプログラムでRangeエラー

    いつもお世話になっております。 Excel2003を使用しております。 シートに直接プログラムを書いています。 （例として、Sheet1とします） シートの内容が変わったときに、色々プログラムを実行していこうと思っているのですが、 Private Sub Worksheet_Change(ByVal Target As Range) のTargetが上手く取得できていない気がします。 今までは上手く動いていたのですが、 急にTargetの値に数値（セルに入力した値）が入ってしまうようになり 上手く組めなくて困っています。 Private Sub Worksheet_Change(ByVal Target As Range) Dim 開始1 As Range Dim 終了1 As Range Dim 開始2 As Range Dim 終了2 As Range Set 開始1 = Range("D5：D63") Set 終了1 = Range("E5：E63") Set 開始2 = Range("F5：F63") Set 終了2 = Range("G5：G63") If ThisWorkbook.ActiveSheet.ProtectContents Then '保護かかってたら End '強制終了 End If If Not Application.Intersect(Target, 開始1) Or Application.Intersect(Target, 実績日開始2) Is Nothing Then Call 開始(Target, 開始1, 開始2) ElseIf Not Application.Intersect(Target, 終了1) Or Application.Intersect(Target, 終了2) Is Nothing Then Msgbox "テスト！" End If End Sub '----------------------------------------------- Sub 開始(ByVal Target As Range, 開始1 As Range, 開始2 As Range) If Not Application.Intersect(Target, 開始1) Is Nothing Then MsgBox Target.Row End If If Not Application.Intersect(Target, 開始2) Is Nothing Then MsgBox Target.Row + 1 End If End Sub 全部シートに書いています。 まだ、テスト段階のため適当なプログラムしか書いておりません。 （指定範囲が変更された場合に、Msgboxを出したりなど 単純なことしかしていません） どこが悪いのか、教えて頂けないでしょうか？ よろしくお願い致します。

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する
質問する