アクティブセルのある行の任意の列範囲を塗りつぶしたい,VBA

質問

2000行、13列のエクセルの表があります。数値を列の右から左の方へ入力しています。
時たま、行を上下に間違えてしまうことがあります。そこで今入力している行に A:M 列の範囲のセルを塗りつぶせないかと思いました。アクティブセルが別の行に移動したら、塗りつぶしを解除し、新しい行を塗りつぶす。こんなことVBAでできないでしょうか。
質問の意図が伝わっているか心配です。不明な点は補足要求をお願いします。

回答No.7

BlueRay · ベストアンサー

>エラーメッセージは「アプリケーション定義またはオブジェクト定義エラーです」なぜでしょうか。
これは、同一名称の変数が定義されている為に出るエラーです。

#1と#4を見比べてもらうとわかると思うのですが、
Public変数（svRow）は、Sheet1からModule1へ移動しています。
たぶん、まだSheet1に定義が残っていませんか？
それを削除してもらえば、エラー無く動作すると思います。
急な変更で、わかりづらくしてしまって申し訳ないです。
※#4の記述は、#1を上書きしてくださいね。(Sheet1)

Sheet1
'************************************************************
Option Explicit

Public svRow As Integer　←　※この行は、Module1に移動してます。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
　　Dim actCol As Integer
　　Dim actRow As Integer
・
・
・

お礼

たびたび、ありがとうございます。
Public svRow As Integer　を Sheet1 から削除してうまく動作しました。
一度ブックを閉じて、再度開いても前回の選択行の塗りつぶしが消えました。書式も変更されることもありません。
★★★完璧です。どうもありがとうございました。

回答No.6

imogasi

＃２のものです。
Okwebでの強制改行を考えて継続行にしたのが仇になったようです。
コピーした後、下記のように修正してください。
私がやったら、上手く動きます。
－－－－－
ツール－マクロ－VBA
ProjectのSheet1をダブルクリック
（General)側をSheet1,(Declaration)側をSelectionChangeを選ぶ
Private Subの外にDim maerowを置く
Private SubからEndSubまでコピー
－－－－－但しOKWEBで改行されるかも知れぬので
If maerow <> "" Then　　　　　　　－－このままOK
ActiveSheet.Range("a1:m100").Rows　－－次ぎの行が
　　　　　　　　　　　　　　　　　　　　　右に続く
(maerow).ClearFormats　－－－－上の行の右につけて
　　　　　　　　　　　　　　　　１行にする。　　
End If　　　　　　　　　　－－－－このまま
ActiveSheet.Range("a1:m100").Rows－－次ぎの行が右
　　　　　　　　　　　　　　　　　　　　に続く
(Target.Row).Interior.ColorIndex = 8　－－上の行の　　　　　　　　　　　　　　　右につけて１行にする。　　
maerow = Target.Row　－－－このままOK
全体で５行です。（Sub とEnd Subを含め７行。
Private Subも含め８行。
手数ですがよろしく。

お礼

何度もありがとうございます。
今度はうまくいきました。スペース_ を改行と気がつかない私の落ち度でした。申し訳ありません。
#1,#3,#4,#5 と何度もご回答いただいた方のご見解を承った後、締め切りたいと思います。

回答No.5

BlueRay

#1と#4の違いです。

#1では、EXCELを使っているのには何の問題もありません。
しかし、一度EXCELを再起動して現在と別な行をクリックすると
保存していた時の行の塗りつぶしが消えないのです。
これを消えるように修正したのが#4です。

>No.４は if ～ Then と　End If は要らないのでしょうか。勝手に・・・
有っても無くても、動作上は問題ないですが無駄になるので消しました。

結論
塗りつぶしされたままで、保存しEXCELを再起動した時の処理の違いですので
EXCEL動作中には、何も違いは有りません。

補足

しつこくてすみません。No.４はうまく動作しません。
エラーメッセージは「アプリケーション定義またはオブジェクト定義エラーです」なぜでしょうか。

回答No.4

BlueRay

まだ、少しばかり甘い所があるので追加＆修正します。

選択状態（塗りつぶし済）で、エクセルを終了し起動し直すと初回のみ
塗りつぶしを解除しないので、それも解除するようにしました。
よって、多少コーディングが変更されたので全てコピペし直してください。

Sheet1は、動作的にはほとんど変わりありません。
ThisWorkbookは、起動時に現在選択されているセルの行を保存しています。
Module1は、svRowがPublicで使用できるように定義しています。

まず、「挿入」→「標準モジュール」で標準モジュールを追加。

以下のソースをSheet1,ThisWorkbook,Module1(標準モジュール)にコピペして下さい。

Sheet1
'********************　ここから　********************
Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
　　Dim actCol As Integer
　　Dim actRow As Integer

　　actCol = Target.Column
　　actRow = Target.Row

　　'With Range(svRow & ":" & svRow).Interior　　　　　　　 '//　全列
　　With Range(Cells(svRow, 1), Cells(svRow, 13)).Interior　'//　列範囲(A:M)
　　　　.ColorIndex = xlNone
　　End With

　　'With Range(actRow & ":" & actRow).Interior　　　　　　　　 '//　全列
　　With Range(Cells(actRow, 1), Cells(actRow, 13)).Interior　　'//　列範囲(A:M)
　　　　.ColorIndex = 36
　　　　.Pattern = xlSolid
　　End With

　　svRow = actRow
End Sub
'********************　ここまで　********************

ThisWorkbook
'********************　ここから　********************
Private Sub Workbook_Open()
svRow = ActiveCell.Row
End Sub
'********************　ここまで　********************

Module1
'********************　ここから　********************
Option Explicit
Public svRow As Integer
'********************　ここまで　********************

補足

すみません。質問しておきながら所用で外出してしまいました。
No.３の解説で cvRow は現在選択した行を覚えておくための変数（入れ物）なんですね。少し分かったような気がします。
No.４は if ～ Then と　End If は要らないのでしょうか。勝手に付け足して動作を試みましたが、No.１と違いが分かりませんでした。

回答No.3

BlueRay

質問のsvRowですがプログラムの最後に、以下の一行があります。
svRow = actRow
これは、現在選択した行を覚えておく為に現在の行を保存しています。
次回には、前回選択した行を覚えておく必要があるので。

エクセルを起動した直後は、プログラムが一度も動いてないのでsvRow=0となります。
というのは、前回選択した行が無いと言う事なのでここでは、塗りつぶし解除を
しなくてもいいので、svRow>0と言う風にしています。

解説がわかりずらくなったのでまとめます。

svRowは、前回選択されている行の塗りつぶし解除の為の行記憶変数。
svRow>0は、起動直後は塗りつぶし解除処理は必要ない為。
と言う事です。

回答No.2

imogasi

例えばSheet1のSelectioChangeイベントに
下記を貼りつけてください。maerowと言うPublic
変数を使っています。
ColorIndex値は適当に淡い色を選んでください。
今はライトブルー。Range("a1:m100")は適当に
変えてしてください（２箇所）。
Dim maerow
'-----
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If maerow <> "" Then
ActiveSheet.Range("a1:m100").Rows _(maerow).ClearFormats
End If
ActiveSheet.Range("a1:m100").Rows _(Target.Row).Interior.ColorIndex = 8
maerow = Target.Row
End Sub

補足

ご回答ありがとうございます。
教えていただいたコードを Sheet1のSelectionChange イベントにコピペしましたがうまく動作しませんでした。構文エラーでした。コピペだけではダメなんでしょうか。もし、注意事項がありましたら教えてください。

回答No.1

BlueRay

>A:M 列の範囲のセルを塗りつぶせないかと
列範囲（A:M）で色をつけています。
※コメント化している部分に変更すれば、全列を色付け対象にします。

(1)Excelの「ツール」→「マクロ」→「Visual Basic Editor」を実行してVBEを起動する。
(2)VBE左上の「プロジェクトエクスプローラ」で「Sheet1」をダブルクリックする。

以下のソースをコピペで貼り付けてください。

'********************　ここから　********************
Option Explicit

Public svRow As Integer

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
　　Dim actCol As Integer
　　Dim actRow As Integer

　　actCol = ActiveCell.Column
　　actRow = ActiveCell.Row

　　If svRow > 0 Then
　　　　'With Range(svRow & ":" & svRow).Interior　　　　　　　 '//　全列
　　　　With Range(Cells(svRow, 1), Cells(svRow, 13)).Interior　'//　列範囲(A:M)
　　　　　　.ColorIndex = xlNone
　　　　End With
　　End If

　　'With Range(actRow & ":" & actRow).Interior　　　　　　　　 '//　全列
　　With Range(Cells(actRow, 1), Cells(actRow, 13)).Interior　　'//　列範囲(A:M)
　　　　.ColorIndex = 36
　　　　.Pattern = xlSolid
　　End With

　　svRow = actRow
End Sub
'********************　ここまで　********************

補足

早速のご回答感謝いたします。
当方の意図したとおりです。完璧でした。ところで後学のために教えて欲しいのですが、svRow というのは何を指しているのでしょうか。svRow > 0 というのが良く分かりません。お手数をおかけしますがよろしくお願いします。