• 締切済み

Excel(VBA)に関しての質問

Excelでスタートボタン配置し、それを押すと指定したセルの配色を変更して ネオンやアニメーションのような動作をするVBAを組もうとしています。 そこで手始めにA1~AS1セルを1セルずつ順番にカラーリングされるVBAを 組んだのですが以下の問題点が発生したので良い対処法等ありましたら 是非ご教授ください。 【問題点】  プログラム実行中、マウスの動きによってカラーリング(処理速度?)の  挙動以下のように変わる。   ・マウスを止めているとき    → 1セル1セルのカラーリングが                     もっさりした動作で遅い   ・マウスを常に動かしているとき → スムーズなカラーリング                     (マウスを止めている時とは段違いに早い) 【希望】  マウスの挙動に依存せずにスムーズなカラーリングを行いたい 【動作環境】  OS : Mac OS X (10.4.11)  Excel : Excel 2004 for Mac (11.5.9) 【VBA】 '開始列定数 startColumn = 1 'A1~AS1までカラーリング While ActiveCell.Address <> "$AS$1" 'カラーリング位置設定 Cells(1, startColumn).Activate 'カラーリング With Cells(1, startColumn).Interior .colorIndex = 10 .Pattern = xlSolid End With '???(ここが問題な気がしますが正直、使い方を理解できていない・・・) 'これがないと1セルずつのカラーリングが行われない DoEvents 'カウント(カラーリング位置を移動) startColumn = startColumn + 1 Wend

みんなの回答

  • sygh
  • ベストアンサー率76% (42/55)
回答No.3

Windows 7 x64 + Excel 2007の互換モードで試しただけなので、OS X + Excel 2004でも正しく動作するかどうか分かりませんが…… ' Sheet1のコードです。 Private g_startColumn As Long Private g_isStoppedFlag As Boolean Private Sub TimerCallbackProc() ' カラーリング位置設定。 Cells(1, g_startColumn).Activate ' カラーリング。 With Cells(1, g_startColumn).Interior .ColorIndex = 10 .Pattern = xlSolid End With ' 他のイベントを処理する。例えば他のボタンの押下イベントなど。 DoEvents 'カウンタのインクリメント(カラーリング列位置を移動)。 g_startColumn = g_startColumn + 1 ' OnTime は最小分解能が1秒のワンショット タイマー。 ' A1~F1までカラーリングするまで、あるいはユーザーによる強制停止の指示があるまで、 ' タイマーイベントを再発行し続ける。 If ActiveCell.Address <> "$F$1" And g_isStoppedFlag = False Then nextTime = Now() + TimeValue("00:00:01") Application.OnTime nextTime, "Sheet1.TimerCallbackProc" Else MsgBox "終了しました。", vbOKOnly & vbInformation CommandButton1.Enabled = True End If End Sub ' 開始ボタンのイベント ハンドラ。 Private Sub CommandButton1_Click() CommandButton1.Enabled = False ' 開始列の設定。 g_startColumn = 1 ' 停止フラグのクリア。 g_isStoppedFlag = False ' 最初の呼び出し。 TimerCallbackProc End Sub ' 停止ボタンのイベント ハンドラ。 Private Sub CommandButton2_Click() g_isStoppedFlag = True End Sub ただし Application.OnTime は最小分解能が1秒なので、500ミリ秒間隔で更新するようなことはできません。 Windowsであればuser32.dllにエクスポートされているWin32 APIのSetTimer/KillTimerを直接コールして、システムのタイマーメッセージを発行させる手がありますが、OS Xの場合は残念ながら僕には分かりません。Mac OS X + ExcelでのシステムAPIコールの仕方を検索なさってください。

  • layy
  • ベストアンサー率23% (292/1222)
回答No.2

処理秒を取得して表示してみる 1セルの繰り返しか 複数選択セルか の違いは? OFFSET使ってみる 秒取得で、今ある処理より遅くなるでしょうが、どの行為が遅いかは見えてくるでしょう。完成したらトル。 いろいろやってみる。

  • o_chi_chi
  • ベストアンサー率45% (131/287)
回答No.1

とりあえず Cells(1, startColumn).Activate をコメントにして実行すればどうでしょう? Cells(1, startColumn).Interior ここでカラーリング位置は設定できます。 DoEventsに関してはヘルプで確認しましょう。

koshin0919
質問者

補足

助言、ありがとうございます。 while文の条件にActiveCellを判断基準にしているので Cells(1, startColumn).Activate をコメントアウトすると無限ループになってしまいます。。 (一応試したのですがマウスによる挙動は変わりませんでした)

関連するQ&A

  • エクセルVBAの質問ですがここでよかったでしょうか?

    エクセルVBAの質問ですがここでよかったでしょうか? Excel2000のマクロを組んでいます。 AutoFilterを使って選んだセルのうち、更にマウスで選択したセルを含むROWを 操作対象にしたいのですが、困っています。 ここにあるコードで概ね動くのですが、セルを一つだけ選択して実行すると 表示されている全てのセルが対象になってしまうようです。 複数選ぶと期待通りの動作になります。 .SpecialCells(xlVisible)を削除すると、この問題は解消するのですが、 AutoFilterで非表示にしたセルまで選択されてしまいます。 なにか良い解決法はないでしょうか? Private Sub ボタン1_Click() Dim CodeNumber As String Dim PartNumber As String Dim activeCells Dim activeRow As Long For Each activeCells In Selection.SpecialCells(xlVisible) activeRow = activeCells.Row If activeRow > 1 Then 'タイトルROWは選んでも無視する CodeNumber = Cells(activeRow, 2).Value PartNumber = Cells(activeRow, 3).Value '色を変えて目印にする Cells(activeRow, 2).Interior.ColorIndex = 34 Call ちょっとした処理(CodeNumber, CodeName) End If Next activeCells End Sub

  • エクセル2007で表集計しています。

    エクセル2007で表集計しています。 ひとつのセルを選択すると、行全体の色が変わるようにしたいのですが、 OKWeveを参考にして下記VBAを使ったのですがうまくいきません。 セキュリティの問題でしょうか?どなたか、詳しい方がみえましたら教えてください。 Private Sub Worksheet_SelectionChange(ByVal Target As Range) Cells.Interior.ColorIndex = xlNone With Target.EntireRow.Interior .ColorIndex = 3 .Pattern = xlSolid End With End Sub

  • VBA

    VBAでCells(1,1)=1と書いて、 エクセルシートの行や列の挿入をすると、 1を書き込みたいセルの位置がずれるのですが、Cells(1,1)=1をCells(2,2)=1とかに 自動的書き換えることは出来ないのでしょうか?

  • エクセルマクロ セルの色つけ

    エクセルのマクロです。 条件で複数セルに色をつけたいのですが以下の方法しかないですか。 もっと多くのセルに一度に色を付ける良い方法がありましたら教えて下さい。 If days = "日" Then With Cells(i, 2).Interior .ColorIndex = 3 .Pattern = xlSolid End With With Cells(i, 13).Interior .ColorIndex = 3 .Pattern = xlSolid End With End If 以上 お願いします。

  • エクセルVBAについて

    エクセルVBA初心者で、勉強している者です。 今、ガントチャートのようなものを作っているのですが、 下記のような記述をしたのですがうまく動きません。 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Sub 時間グラフ作成() If Worksheets("(1)(1)(1)(1)(1)").Range("F2").Value = "10:00" Then Worksheets("(2)(2)(2)(2)").Range("T2").Select With Selection.Interior .ColorIndex = 8 .Pattern = xlSolid End With End If End Sub ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ F2のセルを空にし、「""」で実行すると動きました。 色々調べてみたものの、煮詰まってしまいました・・・。 よろしくお願いいたします。

  • エクセルVBAについて質問です

    お世話になります。 早速ですが、下記の構文を作成しましたが、Activecell.Rowの部分で悪さをし 上手く動きません。 行いたかった事としては、Functionにて関数を手作りしようと試みたのですが、 結局は壁にぶちあたってしまったって所です。。。 内容としては、エクセルが手動計算だった場合は、一回りで動作が終了するので 問題なく想定の値が叩き出されますが、自動計算にした途端に「別セルに入れた 計算式まで、Activecell.Rowに引きずられて計算をし、別の値に変わってしまう」 現象となってしまいました。。。(説明下手で済みません) Public Function Shotoku(houshu As Long) Dim ACcel As Variant Dim FR As Range With Worksheets("所得税月額表(平成24年分)") ACcel = houshu If ACcel < 88000 Then Shotoku = 0 Exit Function End If For Each FR In .Range("C13:C347") If ACcel < FR Then If Cells(ActiveCell.Row, 51) = 0 Then       ←問題の個所です Shotoku = .Cells(FR.Row, 4) ElseIf Cells(ActiveCell.Row, 51) = 1 Then    ←問題の個所です Shotoku = .Cells(FR.Row, 5) ElseIf Cells(ActiveCell.Row, 51) = 2 Then    ←問題の個所です Shotoku = .Cells(FR.Row, 6) ElseIf Cells(ActiveCell.Row, 51) = 3 Then    ←問題の個所です Shotoku = .Cells(FR.Row, 7) ElseIf Cells(ActiveCell.Row, 51) = 4 Then    ←問題の個所です Shotoku = .Cells(FR.Row, 8) ElseIf Cells(ActiveCell.Row, 51) = 5 Then    ←問題の個所です Shotoku = .Cells(FR.Row, 9) ElseIf Cells(ActiveCell.Row, 51) = 6 Then    ←問題の個所です Shotoku = .Cells(FR.Row, 10) ElseIf Cells(ActiveCell.Row, 51) = 7 Then    ←問題の個所です Shotoku = .Cells(FR.Row, 11) End If Exit For End If Next End With End Function 計算式を当て込んで、例えば2行目のIF文の条件に引っかかった場合、他の セルまでその行を読んでしまうので、条件が変わってしまう事態になってます。 イメージではActivecell.Rowがダメなんだと思いますが、これ以外のセル番地の 取得方法が分からなくって><; どなたかお助け願います!!!

  • EXCELのVBAについて教えてください。

    演習1というシートの(1,1)のセルの値と(1,2)のセルの値を入れ替えるプログラムを作成したいので すがエラーが出て出来ません。コードは下記の様に書きました。 Sub 演習1() Dim sheetobj As Worksheet Dim a As Integer Set sheetobj = ThisWorkbook.Worksheets("演習1") With sheetobj a = .Cells(1, 1) .Cells(1, 1) = .Cells(1, 2) .Cells(1, 2) = a End With End Sub プログラミング自体が本を読んでも分かりません。 宜しければ小学生に教えるように文を訳してくれませんか?

  • エクセルVBAでセル選択するコードが変

    エクセルのワークシートでVBAでセル選択するコードで理解に苦しむことがあります。 通常、Cells(2, 1)はセル番地で言えばA2セル Cells(4, 1)はセル番地で言えばA4セルです。 しかし、 With .Range("B5:B15")でくくれば  .Cells(2, 1)はセル番地で言えばB6セルだと思います。 .Cells(4, 1) はセル番地で言えばB8セルだと思います。 ところが下記のコードを動かすと、なぜかC10:C12が選択されてしまいます。 この理屈がわかりません。 Sub test02()   With Sheets("Sheet1")     With .Range("B5:B15")       .Range(.Cells(2, 1), .Cells(4, 1)).Select     End With   End With End Sub なお、 .Range(.Cells(2, 1), .Cells(4, 1)).Selectを .Range(“A2:A4”).Selectに書きかえると、希望のB6:B8が選択されます。

  • エクセルVBAの質問です。

    エクセルVBAの質問です。 セルに特定の値が入力された場合にエラーとし、「再試行」を選択するとセルが修正出来る状態にしたいのですが、下記のコードだと実行時エラーが発生してしまいます。 if cells(10,10).value > 1 then if msgbox("err", vbCritical + vbRetryCancel,"") = vbRetry then Cells(10,10).Select Cells(10,10).Active ⇒ エラー箇所 else Cells(10,10).ClearContents Endif Endif 実行時エラー '438' オブジェクトは、このプロパティまたはメソッドをサポートしてません。 いろいろネットを検索してみましたが、よくわかりませんでした・・・。 VBAは初心者です。 かなり困ってます。 どなたか助言をお願い致します。

  • エクセルVBAで3つ以上のセルをCellsで選択

    エクセル2003のVBAについてお尋ねします。 行番号についてDim X As Integer の構文を使っている関係で Cells(X, 1) Cells(X, 3) Cells(X, 5)などのようにセルの選択をCellsで行う必要があります。 Cellsで離れ離れの3つ以上のセルを同時に選択するには、どのようにしたらよいのでしょうか? Range(Cells(X, 1), Cells(X, 3)).Select では2つしか選択できず困っています。 よろしくお願いいたします。

専門家に質問してみよう