アクティブセルを交点と考え、縦と横の列に色をつけるには？

質問

質問の意味あいがわからないと思いますが、たとえば、アクティヴセルが
E４だとしたとき、E列と４の行をすべて色をつけたい。
どのようにしたらいいでしょうか？
さらには、アクティブセルが移動するごと（入力セルを移動する）に、
上記で設定した色のまま、色がついた列と行を、移動させるためには、
どうしたらいいのでしょうか？

VBAあるいはマクロなど方法があれば教えてください。

回答No.12

ko-taroo

私は集計用シートに入力しやすいようにアクティブセルの横一行だけ色がつくようにできないかと詳しい方に聞いたんですが「エクセル」ではできないといわれました。

回答No.11

KenKen_SP

こんにちは。KenKen_SP です。

ご質問の内容は過去に何回か見かけたことがあり、コードを書いた
こともありますが、いろいろな不都合がでてしまって、こっちが立
てばあちらが立たず、、みたいになかなかうまくいきません。

アクティブセルの位置をもっとわかりやすく、、

といった目的であれば、外部ツールを使うことも検討されてはいか
がですか？（参考URL)

参考までに、コードもアップします。条件付き書式でやってみまし
たので、セルへ着色は可能です。が、今度は条件付き書式が使えま
せん、、（--;

シートモジュールに貼り付けて下さい。では。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

　　Const cstColorIdx As Long = 34 '水色

　　On Error Resume Next
　　'条件付き書式クリア
　　Cells.FormatConditions.Delete
　　'条件付き書式の設定範囲
　　With Target
　　　　Set rngTarget = Union(.EntireRow, .EntireColumn)
　　End With
　　'必ずTrueになる条件式で条件付き書式を設定
　　With rngTarget.FormatConditions.Add _
　　　　(Type:=xlExpression, Formula1:="=Row()>0")
　　　　.Interior.ColorIndex = cstColorIdx
　　End With
　　Set rngTarget = Nothing

End Sub

参考URL：

http://www.vector.co.jp/soft/win95/util/se123742.html

回答No.10

papayuka

#3です。

#5さんへ
セルへのアプローチ方法は多数ありますが、せっかく引数Targetを得ているのですから、使わない手はないと私は思います。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
　MsgBox _
　　"選択エリアは、" & Target.Areas.Count & vbCrLf & _
　　"選択数は、" & Target.Count & vbCrLf & _
　　"先頭アドレスは、" & Target.Cells(1, 1).Address & vbCrLf & _
　　"先頭行は、" & Target.Cells(1, 1).Row & vbCrLf & _
　　"先頭列は、" & Target.Cells(1, 1).Column
End Sub

ただ、TargetはRangeなので、複数エリアを含みます。
複数エリアをループさせて処理するか、先頭のみ処理するかは用途によりますね。

回答No.9

Wendy02

papayukaさん　へ

最初から、#4 のコードは決まっていたものの、しばらくエラーになる条件を考え込んでしまいました。

今回の元のご質問の内容は、ある程度知られた、VBAでも条件付書式でも、定番のコードではあるけれども、今さらになって、本当は、どうしたらよいのか、または、それ自体に無理があるのか、検討をしました。しかし、結論がでないままに、コードを掲示した次第です。

＞違いは複数エリアのセル選択（Ctrl+クリックや、ドラックした場合等）をどう扱うかです。

質問どおりのActiveCellなら、以下のようになるのかな？

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
　Cells.Interior.ColorIndex = xlNone
　With ActiveCell
　　 .EntireColumn.Interior.ColorIndex = 34
　　 .EntireRow.Interior.ColorIndex = 34
　End With
End Sub

回答No.8

wonwonwon

Ｎｏ．５です。

Ｎｏ．３の方のご指摘の通りです。
このように修正してはどうでしょう？

Dim Tate, Yoko As String

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim ACell As String
If Tate = "" Or Yoko = "" Then GoTo tugi
Columns(Tate & ":" & Tate).Interior.ColorIndex = 0
Rows(Yoko & ":" & Yoko).Interior.ColorIndex = 0

tugi:
ACell = ActiveWindow.RangeSelection.Address
If InStr(1, ACell, ":") > 0 Then ACell = Mid(ACell, 1, InStr(1, ACell, ":") - 1)
If InStr(1, ACell, ",") > 0 Then ACell = Mid(ACell, 1, InStr(1, ACell, ",") - 1)
Tate = Mid(ACell, 2, InStr(2, ACell, "$") - 2)
Yoko = Mid(ACell, InStr(2, ACell, "$") + 1)
Columns(Tate & ":" & Tate).Interior.ColorIndex = 6
Rows(Yoko & ":" & Yoko).Interior.ColorIndex = 6
End Sub

回答No.7

papayuka

#3です。

myRangeに以前の選択を保持するつもりで書き始めたけど、結局何も使ってないや、、、
って事で、Dim myRange As Range と Set myRange = Target は不要でした。
Changeじゃないので、Application.EnableEvents もいらないかな。

#4さんのソースはシンプルで良いですね。
参考までに、違いは複数エリアのセル選択（Ctrl+クリックや、ドラックした場合等）をどう扱うかです。

#5さんへ
現状ですと複数エリアのセル選択時（Ctrl+クリックや、ドラックした場合等）に問題があるかと、、、

回答No.6

wonwonwon

Ｎｏ．５の者です。補足です。
当然他の方と同じように任意のセルに色を付けられなくなります。
あと、コード的には回りくどいようなコードかもしれませんが、途中から動作が重くなったりってことはないと思います。

回答No.5

wonwonwon

ども～
こんなのどうでしょう？
Sheetのコードに以下をコピー＆貼り付け

＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿

Dim Tate, Yoko As String

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim ACell As String

If Tate = "" Or Yoko = "" Then GoTo tugi
Columns(Tate & ":" & Tate).Interior.ColorIndex = 0
Rows(Yoko & ":" & Yoko).Interior.ColorIndex = 0

tugi:
ACell = ActiveWindow.RangeSelection.Address
Tate = Mid(ACell, 2, InStr(2, ACell, "$") - 2)
Yoko = Mid(ACell, InStr(2, ACell, "$") + 1)
Columns(Tate & ":" & Tate).Interior.ColorIndex = 6
Rows(Yoko & ":" & Yoko).Interior.ColorIndex = 6
End Sub
＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿

Ｎｏ．３の方と同じ方法になってるのかな
ColorindexはＮｏ．４の方のを参考にされると良いかと。。。他力本願ですみません（汗）

回答No.4

Wendy02

こんばんは。

＞VBAあるいはマクロなど方法があれば教えてください。

設定する画面下方のシートタブを右クリックして、コードの表示で以下を貼り付けます。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
　Cells.Interior.ColorIndex = xlNone
　Target.Cells(1, 1).EntireColumn.Interior.ColorIndex = 34
　Target.Cells(1, 1).EntireRow.Interior.ColorIndex = 34
End Sub

たぶん、私は、これだけでよいと思っています。
オブジェクトの場合は、その部分は隠れます。
なお、アクティブセルといっても、範囲を選択した場合は、その一番上の部分を指します。

色番号で、主に私が使っているものを出しておきます。

'黒(1),白(2),赤(3),黄緑(4),青(5),黄色(6),ピンク(7),
'水色 (8), 茶(9), 緑(10), 藍(11), 黄土色(12), 紫(13), 濃緑(14)
'灰色 (15), 濃い灰色(16),淡い水色(34),ゴールド(44),オレンジ(45),
'黄緑 (35)

回答No.3

papayuka

ソフト名がありませんが、Excelと推測します。
意味が違うかも知れませんがサンプルを書きます。試すなら新規ブックで。

シート名のタブを右クリックして、コードの表示を選択し、出てきたVBE画面にコピペします。
（標準モジュールではなく、Sheetモジュールに書く）

'---------------------------------------------------------------------
Dim myRange As Range

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim r As Range
On Error Resume Next
Application.EnableEvents = False
　Target.Parent.Cells.Interior.ColorIndex = xlNone
　　For Each r In Target
　　　　r.EntireRow.Interior.Color = RGB(255, 255, 153)
　　　　r.EntireColumn.Interior.Color = RGB(255, 255, 153)
　　Next r
　Set myRange = Target
Application.EnableEvents = True
End Sub
'---------------------------------------------------------------------

ただし、これをやると任意のセルに色を付けられなくなりますが、、、