1178685165 エクセルで同一のデータのセルを強調表示することは可能でしょうか?

可能な場合どのようにすればよいでしょうか?
たとえば、添付画像のように、「1」というデータのセルを選択すると、表全体の中で「1」と入力されているセルが強調表示される。
選択セルを「2」に移動すれば、「2」と入力されているセルが強調される。
ご存知の方なにとぞよろしくお願いいたします。

回答の条件
  • URL必須
  • 1人2回まで
  • 登録:
  • 終了:2007/05/10 13:44:23
※ 有料アンケート・ポイント付き質問機能は2023年2月28日に終了しました。

ベストアンサー

id:SALINGER No.1

回答回数3454ベストアンサー獲得回数969

ポイント100pt

使うワークシートの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

ダミー

id:kanienoteiou

ご回答ありがとうございます!!

コードまで書いていただけるとは、、

とてもうれしいです!

さて、上記を試してみたんですが、

そのままコピペして、ためしにデータを

123

232

311

のように入力してみますと、正常に動くのですが、

今度は同じデータを、他のシートからコピーすると、エラーが出てしまいました。

エラーの内容は、

--------------

実行時エラー'13';

型が一致しません。

--------------

となりました。

そこで、「デバッグ」というところをクリックしてみたら、

If Target.Value = "" Then Exit Sub

のところが黄色くマークされました。

修正は可能でしょうか?

もしくは、私が根本的な間違いを犯していますでしょうか?

結構量の多いデータを扱いたいと考えているものですから、

他のシートで作成したデータをコピペできるとうれしいです。

大変恐縮ではありますが、なにとぞご教授ください。

2007/05/09 23:41:28

その他の回答1件)

id:SALINGER No.1

回答回数3454ベストアンサー獲得回数969ここでベストアンサー

ポイント100pt

使うワークシートの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

ダミー

id:kanienoteiou

ご回答ありがとうございます!!

コードまで書いていただけるとは、、

とてもうれしいです!

さて、上記を試してみたんですが、

そのままコピペして、ためしにデータを

123

232

311

のように入力してみますと、正常に動くのですが、

今度は同じデータを、他のシートからコピーすると、エラーが出てしまいました。

エラーの内容は、

--------------

実行時エラー'13';

型が一致しません。

--------------

となりました。

そこで、「デバッグ」というところをクリックしてみたら、

If Target.Value = "" Then Exit Sub

のところが黄色くマークされました。

修正は可能でしょうか?

もしくは、私が根本的な間違いを犯していますでしょうか?

結構量の多いデータを扱いたいと考えているものですから、

他のシートで作成したデータをコピペできるとうれしいです。

大変恐縮ではありますが、なにとぞご教授ください。

2007/05/09 23:41:28
id:SALINGER No.2

回答回数3454ベストアンサー獲得回数969

複数セルを選択したことで、エラーがでたみたいです。

1行目に

If Target.Cells.Count > 1 Then Exit Sub

を入れてみてください。

ダミー

id:kanienoteiou

ありがとうございました!

完璧です!

これがほしかったんです^^

本当に助かりました。

2007/05/10 13:41:36

コメントはまだありません

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

回答リクエストを送信したユーザーはいません