[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『アクティブセルの行を色付けするイベントで一部分の行の場合には色付けしない方法は』（森野ふくろう）
過去ログ[[20200606192625]]の中でもこな２ さんが参考に提供された下記記述を利用させて頂いているのですが、枠の固定をしている表題部の場合でも色付けとなります。
これを1から5行行目までのアクティブの場合は色付けしないようにはできるでしょうか。
よろしくお願いいたします。
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Cells.FormatConditions.Delete
If Intersect(Selection, Range("A:M")) Is Nothing Then Exit Sub
With Intersect(Selection.EntireRow, Range("A:M"))
.FormatConditions.Add Type:=xlExpression, Formula1:="=TRUE"
With .FormatConditions(1).Interior
.Pattern = xlGray50
.PatternColor = vbYellow
End With
End With
End Sub
＜ 使用 Excel：Excel2016、使用 OS：Windows10 ＞
質問は「1から5行行目までのアクティブの場合は色付けしないように」とのことですが、
選択したセルが1～5行目だったら反応しないようにするという意味であれば可能です。
つまりは、「選択したセル」と「6行目～最大行」までが交差するセルが含まれる行に対してのみ、条件付き書式を設定すればよいです。
何をやっているかは、ステップ実行すればわかると思うのでぜひトライしてみてください。
（もこな２ ） 2021/02/10(水) 20:35
条件付き書式設定を開いてみたのですが、おっしゃっていることが理解できません。
ステップ実行もネットで調べましたがよく分かりません。
お手数をお掛けしますが、具体的な方法をご教授お願いできないでしょうか。
よろしくお願いいたします。
（森野ふくろう） 2021/02/10(水) 21:35
両方の Range("A:M") を Range("A6:M1000")
これで希望通りに反応してくれました。
もこな２さん、お手を煩わせて申し訳ございません。
またよろしくお願いいたします。
（森野ふくろう） 2021/02/11(木) 10:43
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim RNG As Range
Cells.FormatConditions.Delete
Set RNG = Intersect(Selection.EntireRow, Range("A6:M" & Rows.Count))
If Not RNG Is Nothing Then
RNG.FormatConditions.Add Type:=xlExpression, Formula1:="=TRUE"
With RNG.FormatConditions(1).Interior
.Pattern = xlGray50
.PatternColor = vbYellow
End With
End If
End Sub
（もこな２） 2021/02/11(木) 15:42
（森野ふくろう） 2021/02/11(木) 18:24
FormatConditionsのDeleteとAddで引っ掛かるんでしょうね...
FormatConditionsはどこかのセルに設定済みであるという条件下なら 適用範囲だけ都度書き換える。という方向で何とかなるかもしれませんね。 (当方の2010環境では動いてくれましたよ)
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim RNG As Range
Dim Fc As FormatCondition
Set RNG = Intersect(Selection.EntireRow, Range("A6:M" & Rows.Count))
For Each Fc In Me.Cells.FormatConditions
If Fc.Formula1 = "=TRUE" Then Fc.ModifyAppliesToRange RNG
Next
End Sub
（白茶） 2021/02/13(土) 20:20
あ、でもたまに変な動きしますね。ブック共有中だけですけど。
セルに文字を入力しようとしたら、タイプと同時に色がひとつ下の段に移りました。 まだ入力確定前なのに。
数字を打つ最中は発生しないみたい。 いやいや、文字の場合でも発生しないケースもあるし、よく分からないですね。
ブック共有を解除したら発生しません。 シートの保護だけ掛けてる状態でも発生しない。
んで、もう一回ブック共有し直してみたら、発生しなくなりました。
ナニコレおもしろい。
（白茶） 2021/02/13(土) 20:42
一応(念の為)確認ですが、
先程のイベントコードは 該当シートのセル全体から[数式:=TRUE]が設定された条件付き書式ルールを探し、 あればソイツの[適用先]を書き換える
という動き(だけ)をしています。
[数式:=TRUE]が設定された条件付き書式ルールが見つからなければ何も起こりません。 (無いからと言ってルールを追加してくれる訳ではございません。Addでエラーになるから)
>>どこかのセルに設定済みであるという条件下 と申しましたのはそういう意味ですが、そちらは大丈夫でしょうか?
「もちろん設定済みだよ」って事であれば、 ちょっと私の環境ではこれ以上の事は分かりかねます。
（白茶） 2021/02/13(土) 22:53
（森野ふくろう） 2021/02/13(土) 23:25
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Select Case Target.Address(False, False)
Case "F1" 'このセルに移動したら
Application.ScreenUpdating = False
With Sheets("説明図") 'これを印刷する
.Visible = True
.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
.Visible = False
End With
Application.ScreenUpdating = True
Range("F2").Select
Case "E2"
Sheets("チェック").Select
Call チェックを消す 'このシートのH列を消す
Case "F3" 'このセルに移動したら
Range("B" & Range("F2") + 6).Select 'このセルに移動する
Dim RNG As Range
Dim Fc As FormatCondition
Set RNG = Intersect(Selection.EntireRow, Range("A6:R" & Rows.Count))
For Each Fc In Me.Cells.FormatConditions
If Fc.Formula1 = "=TRUE" Then Fc.ModifyAppliesToRange RNG
Next
Case "G2" 'このセルに移動したら
Range("F2").Select
Selection.Copy
Range("M2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("P" & Range("M2") + 6).Select 'このセルに移動する
Dim RNG As Range
Dim Fc As FormatCondition
Set RNG = Intersect(Selection.EntireRow, Range("A6:R" & Rows.Count))
For Each Fc In Me.Cells.FormatConditions
If Fc.Formula1 = "=TRUE" Then Fc.ModifyAppliesToRange RNG
Next
Case Else End Select End Sub
（森野ふくろう） 2021/02/14(日) 21:49
Case "F3" 'このセルに移動したら
Range("B" & Range("F2") + 6).Select 'このセルに移動する
Dim RNG As Range ★←これ
Range("P" & Range("M2") + 6).Select 'このセルに移動する
Dim RNG As Rangee ★←これ
同じ名前で定義しようとしてますよ
（もこな２） 2021/02/14(日) 22:33
■１
実は私の環境だと、参考にされた方式もう使ってないんですよね・・・
使わなくした理由は忘れちゃいましたが、白茶さんの「FormatConditionsのDeleteとAddで引っ掛かる」という指摘でなんとなく、同じような状況に遭遇したからだったような気もしてきました。
ちなみに、その問題が発生したときに、私が採った「プランＢ」は、作業列を用意しておき
(1)【手作業で】条件付き書式を設定し作業列に｢1｣が入力されていることを条件にしておく (2)SelectionChangeイベントで作業列をいったんクリアした後、該当する行に「1」を書き込む
という方法にしていました。（結局マクロを使う以上｢元に戻す｣ができないので、こちらの方法も現在は使ってませんが。。。。）
この方法であれば、マクロで行っているのは作業列のクリアと書き込みだけになります。
ブックの共有状態のときに、正常動作するかはわかりませんが、まぁ参考にしてみてください。
■２
[[20210208145023]] 『マクロで非表示シートの印刷ができない』（森野ふくろう）
↑で既にコメントしましたが、VBAの世界では基本的にシートやセル（オブジェクトといいます）を明示すれば、いちいち選択したりアクティブにする必要はありません。
さらに、SelectionChangeイベントの中でセルを選択しなおすような動きをさせているので、このままだと再帰がかかってしまい効率が悪いでしょう。
必要のない選択はしないことを強くお勧めします。
■３
SelectionChangeイベントですと「Target.Address」は「Selection.Address」ということになるから、複数セルが選択された場合、今の考え方ではちょっとまずくないですか？
尤も↓のように仰ってるので、運用上絶対に単一セルずつしか選択しないルールになっているのかもですが・・・
＞具体的にはF2に数値を入力したあと矢印キーでF1、E2、F3(ENTERキー)、G2へ移動した時に作動させたいのです。
■４
「■２」「■３」を踏まえて整理すると、おそらくこんな感じになるとおもいます。
※「チェックを消す」の中身はわかりませんので、適当に作りました。
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Fc As FormatCondition
Stop 'ブレークポイントの代わり
Select Case True
Case Not Intersect(Target, Range("F1")) Is Nothing
Application.ScreenUpdating = False
With Sheets("説明図")
.Visible = True
.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
.Visible = False
End With
Application.ScreenUpdating = True
Case Not Intersect(Target, Range("E2")) Is Nothing
Sheets("チェック").Range("H:H").Clear
Case Not Intersect(Target, Range("F3,G2")) Is Nothing
If Not Intersect(Target, Range("G2")) Is Nothing Then Range("M2").Value = Range("F2").Value
For Each Fc In Me.Cells.FormatConditions
If Fc.Formula1 = "=TRUE" Then Fc.ModifyAppliesToRange Intersect(Rows(Range("F2").Value + 6), Range("A6:R" & Rows.Count))
Next Fc
End Select
End Sub
わからない命令があれば、ネット検索してみて、それでもわからない場合は具体的に質問されるとよいとおもいます。
※Intersectあたりは、悩みそうなのでリンクを置いておきます。
http://officetanaka.net/excel/vba/tips/tips118.htm
（もこな２） 2021/02/15(月) 00:39
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Fc As FormatCondition
Stop 'ブレークポイントの代わり
'▼選択したセルに「F1」が含まれていた場合
If Not Intersect(Target, Range("F1")) Is Nothing Then
Application.ScreenUpdating = False
With Sheets("説明図")
.Visible = True
.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
.Visible = False
End With
Application.ScreenUpdating = True
End If
'▼選択したセルに「E2」が含まれていた場合
If Not Intersect(Target, Range("E2")) Is Nothing Then
Sheets("チェック").Range("H:H").Clear
End If
'▼選択したセルに「F3」あるいは「G2」が含まれていた場合
If Not Intersect(Target, Range("F3,G2")) Is Nothing Then
'▼選択されたセルに｢G2｣が含まれていた場合はM2セルにF2セルの値を転記
If Not Intersect(Target, Range("G2")) Is Nothing Then Range("M2").Value = Range("F2").Value
For Each Fc In Me.Cells.FormatConditions
If Fc.Formula1 = "=TRUE" Then Fc.ModifyAppliesToRange Intersect(Rows(Range("F2").Value + 6), Range("A6:R" & Rows.Count))
Next Fc
End If
End Sub
（もこな２） 2021/02/15(月) 01:34
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.