Excel-VBAのコーディングを教えて下さい。

質問

A列1行目から、2行目3行目・・・に「今日は」「とても」「天気です。」の様な文章が入っていて、「とても」「天気です。」は文字色が白になっています。
B列1行目に「今日は」と入力を完了したら、A2の「とても」が指定秒だけ黒色になりその後白色に戻ります。
B列2行目に「とても」を入力すると、A3の「天気です。」が指定秒だけ黒色になりその後白色に戻ります。
というようにしたいのですが、このようなマクロのコーディング例が欲しいのです。
何に使うかというと、もちろんキーボードレッスンです。
宜しくお願いします。

回答No.4

Wendy02 · ベストアンサー

こんばんは。

#3 で書いたWendy02 です。もう一度、タイミングについて考えてみました。DoEvents が、多少、誤動作をさせるようですが、これなら、入力と色消しのタイミングのズレが解消されているはずです。

'<ThisWorkbook>
Option Explicit
Public WithEvents mySh As Worksheet
Private Sub mySh_Change(ByVal Target As Range)
　With Target.Cells(1, 1)
　 If .Offset(, -1).Value = .Value Then
　　　　.Offset(1, -1).Font.ColorIndex = -4105
　　　　CheckTime 1000
　　　　.Offset(1, -1).Font.ColorIndex = 2
　　　ElseIf .Value <> Empty Then
　　　　.Select
　　　　Beep
　　　　.Offset(, -1).Font.ColorIndex = 3
　　　　CheckTime 1000
　　　　.Offset(, -1).Font.ColorIndex = 2
　 End If
　 If .Row >= Range("A65536").End(xlUp).Row Then
　　　　 If .Value = .Offset(, -1).Value Then
　　　　 MsgBox "終了です。"
　　　　 Call ThisWorkbook.s_TestEnd
　　　　 End If
　　End If
　 End With
End Sub

Sub KeyBoardTest()
'ボタンの起動
With Worksheets("Sheet1")
　.Range("A1", Range("A65536").End(xlUp)).Font.ColorIndex = 2
　.Range("B1", Range("B65536").End(xlUp)).ClearContents
　.Range("B1").Select
　Beep
　.Range("A1").Font.ColorIndex = -4105
　CheckTime 1000　'1000分の1秒
　.Range("A1").Font.ColorIndex = 2
　.Range("B1").Activate
　Set mySh = Worksheets("Sheet1")
　Application.EnableEvents = True
End With
End Sub
Sub s_TestEnd()
　Set mySh = Nothing
End Sub
Sub CheckTime(argInterval As Integer)
Dim myStartTime As Double
Dim myTimer As Double
Dim myInterval As Integer
myStartTime = Timer()
myInterval = argInterval / 1000
　myTimer = Timer()
　 While Timer() - myTimer < myInterval
　　　DoEvents
　 Wend
End Sub

'<Sheetモジュール>
'コントロールツールボタン
Private Sub CommandButton1_Click()
　Call ThisWorkbook.KeyBoardTest
End Sub

回答No.3

Wendy02

こんにちは。

どうも、APIのSleep でよいのかは、ちょっと疑問が残りますね。入力のタイミングが狂います。しかし、タイミングは、OnTimeメソッドがよいのですが、後始末が悪いし、本格的に作るには、もう少し、研究の余地が必要ですね。

ともかく、WithEvents で作ってみました。コントロールツールのボタンをつけてください。

'<Sheet1 モジュール>
Private Sub CommandButton1_Click()
　Call ThisWorkbook.KeyBoardTest
End Sub

'<ThisWorkbookモジュール>

Public WithEvents mySh As Worksheet
Private Declare Sub Sleep Lib "kernel32.dll" _
(ByVal dwMillsecounds As Long)
Dim myTime As Integer
Const myWait As Integer = 2
Private Sub mySh_Change(ByVal Target As Range)
If Target.Count <> 1 Then Exit Sub
　 If Target.Value = Target.Offset(, -1).Value Then
　　　　Target.Offset(1, -1).Font.ColorIndex = -4105
　　　　Sleep myWait * 700
　　　　Target.Offset(1, -1).Font.ColorIndex = 2
　　　ElseIf Target.Value <> Empty Then
　　　　Beep
　　　　Target.Select
　　　　Target.Offset(, -1).Font.ColorIndex = 3
　　　　 Sleep myWait * 500
　　　　Target.Offset(, -1).Font.ColorIndex = 2
　 End If
　 If Target.Row >= Range("A65536").End(xlUp).Row Then
　　　　 If Target.Value = Target.Offset(, -1).Value Then
　　　　 MsgBox "終了です。"
　　　　 Call ThisWorkbook.s_TestEnd
　　　　 End If
　　End If
End Sub

Sub KeyBoardTest()
With Worksheets("Sheet1")
　.Range("A1", Range("A65536").End(xlUp)).Font.ColorIndex = 2
　.Range("B1", Range("B65536").End(xlUp)).ClearContents
　.Range("A1").Font.ColorIndex = -4105
　Sleep myWait * 700
　.Range("A1").Font.ColorIndex = 2
　Beep
　.Range("B1").Select
　Set mySh = Worksheets("Sheet1")
　Application.EnableEvents = True
End With
End Sub
Sub s_TestEnd()
　Set mySh = Nothing
End Sub

回答No.2

onntao

pen_pen_penさんのをそのままお借りして
質問にそのまま沿うと

Private Declare Sub Sleep Lib "kernel32.dll" _
(ByVal dwMillsecounds As Long)

Private Sub Worksheet_Change(ByVal Target As Range)
Dim aCell As Range

'B列以外への入力は無視。
If Target.Column <> 2 Then Exit Sub

'入力セルの左１行下のセルを取得
Set aCell = Cells(Target.Row + 1, 1)

'そのセルの文字色が白なら。
If aCell.Font.Color = vbWhite Then
aCell.Font.Color = vbBlack '該当セルの文字色を黒に
Sleep 1000 '1秒待つ
aCell.Font.Color = vbWhite '該当セルの文字色を白に
End If
End Sub

回答No.1

pen_pen_pen

たぶん想定してるのと違うかも。
指定秒、A列のセル色が黒に変わってる間だけ
マウスポインタが砂時計になって何もできなくなります。
10秒にしてみたら固まったかと思いました（＾＾；；）
ワークシートのモジュールに書いて下さい。

Private Declare Sub Sleep Lib "kernel32.dll" _
(ByVal dwMillsecounds As Long)

Private Sub Worksheet_Change(ByVal Target As Range)
Dim aCell As Range

'B列以外への入力は無視。
If Target.Column <> 2 Then Exit Sub

'入力セルと同じ行のA列のセルを取得
Set aCell = Cells(Target.Row, 1)

'セルの内容がA列=B列なら。
If aCell.Value = Target.Value Then
aCell.Font.Color = vbBlack 'A列の文字色を黒に
Sleep 1000 '1秒待つ
aCell.Font.Color = vbWhite 'A列の文字色を白に
End If
End Sub