こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

締切り済みの質問

エクセル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

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

投稿日時 - 2003-10-23 12:33:51

QNo.686991

困ってます

このQ&Aは役に立ちましたか?

5人が「このQ&Aが役に立った」と投票しています

回答(8)

ANo.8

質問者でも無いのに済みません。#6です。#4,5,7のpapayukaさんありがとうございました。いつも教えていただいています。

投稿日時 - 2003-10-23 23:22:24

ANo.7

#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

投稿日時 - 2003-10-23 22:05:24

ANo.6

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を先に1回だけ実行すれば、お望みのようになるのでは。
(ただしChangeイベントプロシージュアーだけだとエラーになります。)
コードが短くて良いと思うのですが、ただ以前から上記mtargetを初期化する方法を知りたいのですが、わかりません。
あるいは初回だけmtarget.Interior.ColorIndex = xlNoneを飛ばすことが出きれば良いのですが。
中と半端ですが何かの参考になれば。

投稿日時 - 2003-10-23 21:13:57

ANo.5

#4です。

変数 r As Range

は不要でした。

投稿日時 - 2003-10-23 20:26:39

ANo.4

横から失礼します。

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

投稿日時 - 2003-10-23 20:23:55

ANo.3

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

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

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
'---------------------------------------------------------------

投稿日時 - 2003-10-23 16:06:15

ANo.2

#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

投稿日時 - 2003-10-23 13:31:36

補足

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

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

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

投稿日時 - 2003-10-23 14:25:54

ANo.1

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


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

投稿日時 - 2003-10-23 13:10:40

お礼

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

投稿日時 - 2003-10-23 14:32:48

あなたにオススメの質問