人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

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

これを拡張して、
例えば

D3

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


●質問者: onigirin
●カテゴリ:コンピュータ インターネット
✍キーワード:エクセル セル 拡張
○ 状態 :終了
└ 回答数 : 3/3件

▽最新の回答へ

1 ● きゃづみぃ
●20ポイント

ワークシートのほうに

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

を 記述すれば できます。

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

◎質問者からの返答

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

できた!

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


2 ● きゃづみぃ
●20ポイント

ワークシートを 二つ作成して それぞれ 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
◎質問者からの返答

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

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

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


3 ● ardarim
●40ポイント ベストアンサー

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

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

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

◎質問者からの返答

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

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

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

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ