エクセルで、

特定のセルを選択したときに
行と列の番号のところに色がついて、
「今、この行と列だよ」
とわかりやすくなっています。

これを拡張して、
例えば

D3

を選択したとき、D列と3の行のセル全てに色がついて、
「今この列とこの行だよ」というのを
もっとわかりやすくしたいのですが、
これを実現できる方法があれば、実現方法をお願いします。

回答の条件
  • 1人3回まで
  • 登録:2007/09/14 18:01:52
  • 終了:2007/09/17 19:14:20

ベストアンサー

id:ardarim No.3

ardarim回答回数892ベストアンサー獲得回数1422007/09/14 23:55:59

ポイント40pt

ちょっと作ってみたのはいいものの。

重いし、いまいちかも...

Option Explicit

' Trueにするとより目立つが、オブジェクトがかぶさるため
' マウスでセルを選択しにくくなる
Private Const UseFill As Boolean = False

' 枠の色(RGB 256階調; B*65536+G*256+R)
Private Const FrameColor As Long = 255

Sub ShowIndicator(IndicatorName As String, x As Long, y As Long, cx As Long, cy As Long)

    Dim shp As Shape
    
    Set shp = Nothing
    On Error Resume Next
    Set shp = ActiveSheet.Shapes(IndicatorName)
    On Error GoTo 0
    
    If TypeName(shp) = "Nothing" Then
        ActiveSheet.Shapes.AddShape(msoShapeRectangle, x, y, cx, cy).Select
        Selection.Name = IndicatorName
        
        If UseFill Then
            Selection.ShapeRange.Fill.Transparency = 0.8
            Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
            Selection.ShapeRange.Fill.Visible = msoTrue
        Else
            Selection.ShapeRange.Fill.Visible = msoFalse
        End If
        
        Selection.ShapeRange.Line.Weight = 1.5
        Selection.ShapeRange.Line.DashStyle = msoLineSolid
        Selection.ShapeRange.Line.Style = msoLineSingle
        Selection.ShapeRange.Line.Visible = msoTrue
        Selection.ShapeRange.Line.ForeColor.RGB = FrameColor
    Else
        shp.Select
        Selection.Left = x
        Selection.Top = y
        Selection.Width = cx
        Selection.Height = cy
    End If
        
End Sub

Sub Worksheet_SelectionChange(ByVal Target As Range)
        
    Dim prevSelection As Object
    
    Dim x As Long, y As Long
    Dim cx As Long, cy As Long
    
    Set prevSelection = Selection
    
    x = Target.Left
    y = 0
    cx = Columns(Target.Column).Width
    cy = ActiveSheet.Rows(ActiveSheet.Rows.Count).Top + ActiveSheet.Rows(ActiveSheet.Rows.Count).Height
    
    Call ShowIndicator("ColumnIndicator", x, y, cx, cy)
    
    x = 0
    y = Target.Top
    cx = ActiveSheet.Columns(ActiveSheet.Columns.Count).Left + ActiveSheet.Columns(ActiveSheet.Columns.Count).Width
    cy = Rows(Target.Row).Height
    
    Call ShowIndicator("RowIndicator", x, y, cx, cy)
        
    prevSelection.Select
    
End Sub

id:onigirin

どうもありがとうございます。

若干変な動きをしながらも、目的は達成されました!

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

2007/09/17 19:12:26

その他の回答(2件)

id:taknt No.1

きゃづみぃ回答回数13537ベストアンサー獲得回数11982007/09/14 19:18:44

ポイント20pt

ワークシートのほうに

Dim a As Long
Dim b As Long


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If a > 0 And b > 0 Then
        Rows(a).Interior.ColorIndex = xlNone
        Columns(b).Interior.ColorIndex = xlNone
    End If
    
    Rows(Target.Row).Interior.ColorIndex = 6
    Rows(Target.Row).Interior.Pattern = xlSolid
    Columns(Target.Column).Interior.ColorIndex = 6
    Columns(Target.Column).Interior.Pattern = xlSolid
    
    a = Target.Row
    b = Target.Column
    
End Sub

を 記述すれば できます。

ただし セルの背景は 一括で消去されてしまいますが・・・。

id:onigirin

どうもありがとうございます。

できた!

と思ったら、確かに背景が消えていきますね・・・。

2007/09/14 19:38:38
id:taknt No.2

きゃづみぃ回答回数13537ベストアンサー獲得回数11982007/09/14 22:45:44

ポイント20pt

ワークシートを 二つ作成して それぞれ WK1とWK2にします。

それぞれのシートに 縦と横の情報を コピーして 保存し、セルの位置が 変わったときに 元に戻してます。

Dim a As Long
Dim b As Long


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If a > 0 And b > 0 Then
        Sheets("WK1").Rows(1).Copy
        Paste Destination:=Rows(a)
        
        Sheets("WK2").Columns(1).Copy
        Paste Destination:=Columns(b)
    End If

    a = Target.Row
    b = Target.Column
    
    Rows(a).Copy
    Paste Destination:=Sheets("WK1").Rows(1)
    
    Columns(b).Copy
    Paste Destination:=Sheets("WK2").Columns(1)

    Rows(a).Interior.ColorIndex = 6
    Rows(a).Interior.Pattern = xlSolid
    Columns(b).Interior.ColorIndex = 6
    Columns(b).Interior.Pattern = xlSolid
    Cells(a, b).Select
End Sub
id:onigirin

どうもありがとうございます。

ワークシート2ついるのですね・・・。

いろいろ書いていただいてありがとうございました!

2007/09/17 19:12:03
id:ardarim No.3

ardarim回答回数892ベストアンサー獲得回数1422007/09/14 23:55:59ここでベストアンサー

ポイント40pt

ちょっと作ってみたのはいいものの。

重いし、いまいちかも...

Option Explicit

' Trueにするとより目立つが、オブジェクトがかぶさるため
' マウスでセルを選択しにくくなる
Private Const UseFill As Boolean = False

' 枠の色(RGB 256階調; B*65536+G*256+R)
Private Const FrameColor As Long = 255

Sub ShowIndicator(IndicatorName As String, x As Long, y As Long, cx As Long, cy As Long)

    Dim shp As Shape
    
    Set shp = Nothing
    On Error Resume Next
    Set shp = ActiveSheet.Shapes(IndicatorName)
    On Error GoTo 0
    
    If TypeName(shp) = "Nothing" Then
        ActiveSheet.Shapes.AddShape(msoShapeRectangle, x, y, cx, cy).Select
        Selection.Name = IndicatorName
        
        If UseFill Then
            Selection.ShapeRange.Fill.Transparency = 0.8
            Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
            Selection.ShapeRange.Fill.Visible = msoTrue
        Else
            Selection.ShapeRange.Fill.Visible = msoFalse
        End If
        
        Selection.ShapeRange.Line.Weight = 1.5
        Selection.ShapeRange.Line.DashStyle = msoLineSolid
        Selection.ShapeRange.Line.Style = msoLineSingle
        Selection.ShapeRange.Line.Visible = msoTrue
        Selection.ShapeRange.Line.ForeColor.RGB = FrameColor
    Else
        shp.Select
        Selection.Left = x
        Selection.Top = y
        Selection.Width = cx
        Selection.Height = cy
    End If
        
End Sub

Sub Worksheet_SelectionChange(ByVal Target As Range)
        
    Dim prevSelection As Object
    
    Dim x As Long, y As Long
    Dim cx As Long, cy As Long
    
    Set prevSelection = Selection
    
    x = Target.Left
    y = 0
    cx = Columns(Target.Column).Width
    cy = ActiveSheet.Rows(ActiveSheet.Rows.Count).Top + ActiveSheet.Rows(ActiveSheet.Rows.Count).Height
    
    Call ShowIndicator("ColumnIndicator", x, y, cx, cy)
    
    x = 0
    y = Target.Top
    cx = ActiveSheet.Columns(ActiveSheet.Columns.Count).Left + ActiveSheet.Columns(ActiveSheet.Columns.Count).Width
    cy = Rows(Target.Row).Height
    
    Call ShowIndicator("RowIndicator", x, y, cx, cy)
        
    prevSelection.Select
    
End Sub

id:onigirin

どうもありがとうございます。

若干変な動きをしながらも、目的は達成されました!

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

2007/09/17 19:12:26
  • id:taknt
    エクセルの機能としては、なさそうなので VBAで 力技ですが、前の背景を残すには いろいろ面倒そうなのでとりあえず このようにしてみました。
    背景を使わずに 使用したらいいと思います。

  • id:onigirin
    どうもありがとうございます。
    残念ながら背景色を使ってるんです・・・。
  • id:taknt
    別にワーク用のシート等に コピーして というのならば 可能ですが・・・

  • id:onigirin
    どうもありがとうございます。
    今使っているシートそのまま実現したいと思っています・・・。

    実現が難しいなら、それはそれでいいと思っています。
  • id:taknt
    作ってみましたが、参照だけですね。

    セルに変更を 加えても 元のを コピーしなおしちゃうから 消えてしまいました・・・。

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

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

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

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません