エクセルVBAでクリックしたセルのみ書式を変えたいのです。

質問

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
If Target.Row <= 11 And Target.Column <= 11 Then
With Selection
.Interior.ColorIndex = 3
.Font.ColorIndex = 2
.Font.Bold = True
End With
End If
End Sub

これで出来るのですが、問題は別のセルに移動しても書式は変ったままなのです。（当り前ですが）
書式を変えるのはあくまで選択されている間だけにしたいのです。
どのようにすればよいのでしょうか？
エクセル９７です。

回答No.8

imogasi

質問者でも無いのに済みません。＃６です。＃４，５，７のpapayukaさんありがとうございました。いつも教えていただいています。

回答No.7

papayuka

#6 imogasiさんの下記に対しての返信です。

> 初回だけmtarget.Interior.ColorIndex = xlNoneを
> 飛ばすことが出きれば良いのですが。

Nothing か判定すれば良さそうですね。

Dim mtarget As Range
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
　If Not mtarget Is Nothing Then
　　 mtarget.Interior.ColorIndex = xlNone
　End If
　Target.Interior.Color = vbYellow
　Set mtarget = Target
End Sub

回答No.6

imogasi

If Target.Row <= 11 And Target.Column <= 11 Then
などを（ポイントを絞るために）いま考えずにおきます。
Public mtarget
'-----
Sub test01()
Set mtarget = ActiveCell
End Sub
'-----
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
mtarget.Interior.ColorIndex = xlNone
Target.Interior.Color = vbYellow
Set mtarget = Target
End Sub
コマンドボタン等で、test01を先に１回だけ実行すれば、お望みのようになるのでは。
（ただしChangeイベントプロシージュアーだけだとエラーになります。）
コードが短くて良いと思うのですが、ただ以前から上記mtargetを初期化する方法を知りたいのですが、わかりません。
あるいは初回だけmtarget.Interior.ColorIndex = xlNoneを飛ばすことが出きれば良いのですが。
中と半端ですが何かの参考になれば。

回答No.5

papayuka

#4です。

変数　r As Range

は不要でした。

回答No.4

papayuka

横から失礼します。

Selection でなく、あくまで Target で判断するべきだと思います。

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Dim myRange As Range, r As Range
　'これが「表」範囲として
　Set myRange = Range("A1:K11")
　'Ctrlを押しながらの複数選択なら無駄に消さない
　If Target.Areas.Count = 1 Then
　　 myRange.Interior.ColorIndex = xlNone
　　 myRange.Font.ColorIndex = 0
　　 myRange.Font.Bold = False
　End If
　Set Target = Application.Intersect(Target, myRange)
　'Target範囲内に myRange範囲がなければ抜ける
　If Target Is Nothing Then Exit Sub
　Target.Interior.ColorIndex = 3
　Target.Font.ColorIndex = 2
　Target.Font.Bold = True
End Sub

回答No.3

noname#27115

' 選択領域の行数/列数をとる方法を知らなかったので、いらない
' だらだらしたプロシージャーを作ってしまいましたが。。。
' そういった関数があったら代用してください。

' 理屈としては次のものでいけないでしょうか？
' 行/列 全選択をすると落ちるので、、エラー処理プロセスは入れる
' 必要があります。

Dim myRow(1) As Long
Dim myCol(1) As Long
'---------------------------------------------------------------
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Dim i As Long
Dim j As Long

Set Target = Application.Intersect(Range("表"), Target)

With Range("表")
.Interior.ColorIndex = xlNone
.Font.ColorIndex = 0
.Font.Bold = False
End With

Application.ScreenUpdating = False

If Target Is Nothing Then Exit Sub

With Selection
SetmyAddresses Selection.Address(ReferenceStyle:=xlR1C1)
For i = myRow(0) To myRow(1)
If i <= 11 Then
For j = myCol(0) To myCol(1)
If j <= 11 Then
Cells(i, j).Interior.ColorIndex = 3
Cells(i, j).Font.ColorIndex = 2
Cells(i, j).Font.Bold = True
Else: Exit For
End If
Next j
Else: Exit For
End If
Next i
End With
Application.ScreenUpdating = True
End Sub
'---------------------------------------------------------------
Private Sub SetmyAddresses(myAddress As String)
Dim myBuf(1) As String
Dim CNT As Long

CNT = IIf(InStr(1, myAddress, ":") > 0, 1, 0)

Select Case CNT
Case 0
myBuf(1) = Mid(myAddress, InStr(1, myAddress, ":") + 1, Len(myAddress) - InStr(1, myAddress, ":"))
myRow(1) = Mid(myBuf(1), InStr(1, myBuf(1), "R") + 1, (InStr(1, myBuf(1), "C") - InStr(1, myBuf(1), "R") - 1))
myCol(1) = Mid(myBuf(1), InStr(1, myBuf(1), "C") + 1, Len(myBuf(1)) - InStr(1, myBuf(1), "C"))

myRow(0) = myRow(1)
myCol(0) = myCol(1)
Case 1
myBuf(0) = Mid(myAddress, 1, InStr(1, myAddress, ":") - 1)
myBuf(1) = Mid(myAddress, InStr(1, myAddress, ":") + 1, Len(myAddress) - InStr(1, myAddress, ":"))

myRow(0) = Mid(myBuf(0), InStr(1, myBuf(0), "R") + 1, (InStr(1, myBuf(0), "C") - InStr(1, myBuf(0), "R") - 1))
myRow(1) = Mid(myBuf(1), InStr(1, myBuf(1), "R") + 1, (InStr(1, myBuf(1), "C") - InStr(1, myBuf(1), "R") - 1))

myCol(0) = Mid(myBuf(0), InStr(1, myBuf(0), "C") + 1, Len(myBuf(0)) - InStr(1, myBuf(0), "C"))
myCol(1) = Mid(myBuf(1), InStr(1, myBuf(1), "C") + 1, Len(myBuf(1)) - InStr(1, myBuf(1), "C"))
End Select
End Sub
'---------------------------------------------------------------

回答No.2

noname#27115

#1です。

こっちの方がいいかもしれません。

Dim oldRow, oldCol As Long

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)

　If oldRow > 0 And oldCol > 0 Then
　　　　With Cells(oldRow, oldCol)
　　　　　　.Interior.ColorIndex = xlNone
　　　　　　.Font.ColorIndex = 0
　　　　　　.Font.Bold = False
　　　　End With
　End If

　If Target.Row <= 11 And Target.Column <= 11 Then

　　　　With Selection
　　　　　　.Interior.ColorIndex = 3
　　　　　　.Font.ColorIndex = 2
　　　　　　.Font.Bold = True
　　　　End With

　　　　oldRow = Target.Row
　　　　oldCol = Target.Column

　　End If
End Sub

補足

ありがとうございます。
やってみましたが、複数セルを選択すると色が残ってしまうので、このように変えてみました。
適用したい部分に「表」と定義しました。

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)

Set Target = Application.Intersect(Range("表"), Target)

With Range("表")
.Interior.ColorIndex = xlNone
.Font.ColorIndex = 0
.Font.Bold = False
End With

If Target Is Nothing Then Exit Sub

With Selection
.Interior.ColorIndex = 3
.Font.ColorIndex = 2
.Font.Bold = True
End With

End Sub

これでほぼＯＫなのですが、一つだけ問題があります。
表とそれ以外のセルを同時に選択すると、表以外のセルにまで同じ書式設定がされてしまいます。
表以外のセルには別の書式が設定してあるので困ってしまいました。
お教え願いませんでしょうか？

回答No.1

noname#27115

先に次の形で初期化してはどうでしょうか？

With Cells
　　　.Interior.ColorIndex = xlNone
　　　.Font.ColorIndex = 0
　　　.Font.Bold = False
End With

お礼

さっそくありがとうございました。