可能な場合どのようにすればよいでしょうか?
たとえば、添付画像のように、「1」というデータのセルを選択すると、表全体の中で「1」と入力されているセルが強調表示される。
選択セルを「2」に移動すれば、「2」と入力されているセルが強調される。
ご存知の方なにとぞよろしくお願いいたします。
使うワークシートのSelectionChangeイベントに次のコードを入れます。
分からなければVBEの画面のプロジェクトエクスプローラで実行させるシートを
ダブルクリックして出てくる真っ白の画面にコピペしてください。
もともと表とかの枠を設定していると消えてしまうので注意
Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim myRange As Range Application.ScreenUpdating = False For Each myRange In ActiveSheet.UsedRange With myRange .Borders(xlEdgeLeft).LineStyle = xlNone .Borders(xlEdgeTop).LineStyle = xlNone .Borders(xlEdgeBottom).LineStyle = xlNone .Borders(xlEdgeRight).LineStyle = xlNone End With Next If Target.Value = "" Then Exit Sub For Each myRange In ActiveSheet.UsedRange If myRange.Value = Target.Value Then With myRange.Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = 3 End With With myRange.Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = 3 End With With myRange.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = 3 End With With myRange.Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = 3 End With End If Next End Sub
使うワークシートのSelectionChangeイベントに次のコードを入れます。
分からなければVBEの画面のプロジェクトエクスプローラで実行させるシートを
ダブルクリックして出てくる真っ白の画面にコピペしてください。
もともと表とかの枠を設定していると消えてしまうので注意
Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim myRange As Range Application.ScreenUpdating = False For Each myRange In ActiveSheet.UsedRange With myRange .Borders(xlEdgeLeft).LineStyle = xlNone .Borders(xlEdgeTop).LineStyle = xlNone .Borders(xlEdgeBottom).LineStyle = xlNone .Borders(xlEdgeRight).LineStyle = xlNone End With Next If Target.Value = "" Then Exit Sub For Each myRange In ActiveSheet.UsedRange If myRange.Value = Target.Value Then With myRange.Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = 3 End With With myRange.Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = 3 End With With myRange.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = 3 End With With myRange.Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = 3 End With End If Next End Sub
ご回答ありがとうございます!!
コードまで書いていただけるとは、、
とてもうれしいです!
さて、上記を試してみたんですが、
そのままコピペして、ためしにデータを
123
232
311
のように入力してみますと、正常に動くのですが、
今度は同じデータを、他のシートからコピーすると、エラーが出てしまいました。
エラーの内容は、
--------------
実行時エラー'13';
型が一致しません。
--------------
となりました。
そこで、「デバッグ」というところをクリックしてみたら、
If Target.Value = "" Then Exit Sub
のところが黄色くマークされました。
修正は可能でしょうか?
もしくは、私が根本的な間違いを犯していますでしょうか?
結構量の多いデータを扱いたいと考えているものですから、
他のシートで作成したデータをコピペできるとうれしいです。
大変恐縮ではありますが、なにとぞご教授ください。
ご回答ありがとうございます!!
コードまで書いていただけるとは、、
とてもうれしいです!
さて、上記を試してみたんですが、
そのままコピペして、ためしにデータを
123
232
311
のように入力してみますと、正常に動くのですが、
今度は同じデータを、他のシートからコピーすると、エラーが出てしまいました。
エラーの内容は、
--------------
実行時エラー'13';
型が一致しません。
--------------
となりました。
そこで、「デバッグ」というところをクリックしてみたら、
If Target.Value = "" Then Exit Sub
のところが黄色くマークされました。
修正は可能でしょうか?
もしくは、私が根本的な間違いを犯していますでしょうか?
結構量の多いデータを扱いたいと考えているものですから、
他のシートで作成したデータをコピペできるとうれしいです。
大変恐縮ではありますが、なにとぞご教授ください。