右表を参照して該当する左表のセルを点滅させる

質問

右表は日々変わる表で、７列からなる表です。
左表は７列×30行からなる表です。
「点滅」ボタンを押すごとに、右表の一列目に示されている数と同じ数値のセルの色を左表から選んで
セルの色を点滅させます。
別の「消す」というボタンを押すと点滅が消えて元に戻ります。

次いで最初の「点滅」ボタンを押すと、今度は右表の二列目に示されている数値と同じものを左表から選んで、セルの色を点滅してくれる・・・。これを次々と１０列まで続けたいのですが。

右表も左表も同一シート上に作ります。
どうか宜しくお願いいたします。

回答No.1

mitarashi

セルの点滅で検索すると、APIを用いたコード等見つかりますが、実際使っている人が居るのかな？最近新しい手法のタイマーの記事をみつけたので、それを使うためにコードを書いてみましたが、実用性は疑問です。質問は受けられませんので、ソースをお読みいただき、ご自分の環境にアレンジできるようなら、ご活用下さい。
・シートモジュールに記述して下さい。
・コントロールツールのコマンドボタンを２個、シートに配置して下さい。
・セルを着色する部分は、ご提示の仕様と異なっているかもしれません。
なお、xl2000用のコードです。
Private rightTable As Range, leftTable As Range, targetCell As Range
Private myColumnNo As Long
Private startFlag As Boolean
Private myColorIndex As Long

Private m_TimerId As Variant
Private m_doc As Object
Const ATTRNAME = "VBATimerHandler"

Private Sub StartTimer(interval As Long)
Const Script = "document.documentElement.getAttribute('" & ATTRNAME & "').TimerProc()"
EndTimer
Set m_doc = CreateObject("htmlfile")
m_doc.DocumentElement.setAttribute ATTRNAME, Me
m_TimerId = m_doc.parentWindow.setInterval(Script, interval)
End Sub

Private Sub EndTimer()
If m_doc Is Nothing Then Exit Sub
If Not IsEmpty(m_TimerId) Then
m_doc.parentWindow.clearInterval m_TimerId
m_TimerId = Empty
End If
m_doc.DocumentElement.removeAttribute ATTRNAME
Set m_doc = Nothing
End Sub

Public Sub TimerProc()
If targetCell.Interior.ColorIndex = myColorIndex Then
targetCell.Interior.ColorIndex = 3
Else
targetCell.Interior.ColorIndex = myColorIndex
End If
End Sub

Private Sub CommandButton1_Click()
If Not startFlag Then
'ここで左右の表のエリアを設定する
Set rightTable = Range("I2").Resize(, 7)
Set leftTable = Range("A2").Resize(30, 7)
startFlag = True
myColumnNo = 1
End If
rightTable.Cells(myColumnNo).Activate
Set targetCell = leftTable.Find(rightTable.Cells(myColumnNo).Value, LookIn:=xlValues, LookAt:=xlWhole)
If targetCell Is Nothing Then
MsgBox "見つかりませんでした"
myColumnNo = myColumnNo + 1
Exit Sub
End If
myColorIndex = targetCell.Interior.ColorIndex
StartTimer (200)
End Sub

Private Sub CommandButton2_Click()
EndTimer
If Not targetCell Is Nothing Then targetCell.Interior.ColorIndex = myColorIndex
myColumnNo = myColumnNo + 1
If myColumnNo > rightTable.Cells.Count Then
startFlag = False
End If
End Sub

参考URL：

http://www.ka-net.org/office/of12.html