[[20191225085916]] 『列方向に対しての色付き枠線の検索方法』(とあ) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『列方向に対しての色付き枠線の検索方法』(とあ)

単独セル、結合セルが混ざった表があるとします。
またその表は、黒の枠線が引かれております。(外枠だけでなく全て)

そこで、セルをクリックするとクリックしたセルの枠が赤くなるようにしてあります。

ここからが質問の内容になるのですが、
セルをクリックした際に、その列に既に赤枠になっているセルが存在する場合、
その赤枠を黒枠に直し、クリックしたセルを赤枠にする 
ということはできませんか?

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

でマクロ実行されるため、クリック後の状態を確保しておくことが出来ないと思われ、セルがクリックされるたびの確認しかないかなと思っています。
だが、クリックした列に対し、単独セルおよび結合セルが赤枠になっているかの検索方法がわからず、どなたか教えて頂けたらと思います。

< 使用 Excel:Excel2013、使用 OS:Windows7 >


セルをクリックすると赤枠になる、との事ですが、枠とは、罫線で実現しているのか、矩形オブジェクトで実現しているのか判らないと、答えようがないです。 マクロで実現しているのでしょうから、まずは今のコードを見せてください。

枠線が罫線だとして、案だけで良ければ、ぱっと2つほど思いつきます。
(1)シート全てのセルを調べて、罫線があれば全部黒くしてから、現在の方法で赤くする。
(2)赤くする際、そのセル範囲を共通変数に覚えておき、前回塗ったセルがあるならそこを黒にしてから、現在の方法で赤くする。

枠線が矩形オブジェクトなら、新たにオブジェクトを置くのではなく、1つの赤枠オブジェクトの座標を変えるだけの事でしょう。
(???) 2019/12/25(水) 09:35


 書式の検索は、マクロの記録でできますよね
 検索する書式の指定は、Application.FindFormatプロパティです。

 罫線だと面倒なので、塗りつぶしのサンプルです。

    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
       Static previousTarget As Range

       If Not previousTarget Is Nothing Then
          previousTarget.Interior.ColorIndex = xlNone
       End If

       Target.Interior.ColorIndex = 3

       Set previousTarget = Target

    End Sub
(´・ω・`) 2019/12/25(水) 09:42

現在は下記のコードで、結合セルか単独セルかを判定し、
罫線で赤枠にしています。

そして、シート全てのセルに枠線がついているのではなく、
A列〜K列のように、ある特定の場所に表が作成され
その表全体に枠線がついている状態です。

(2)赤くする際、そのセル範囲を共通変数に覚えておき、前回塗ったセルがあるならそこを黒にしてから、現在の方法で赤くする。
⇒セルがクリックされるたびにマクロが実行されますが、マクロ終了後、再度他のセルをクリックしたらマクロが実行されますが、前の情報を覚えておくことなどできるのですか?

If Cells(Target.Row, Target.column).MergeCells Then '選択したセルが結合セルの場合

  area = Cells(Target.Row, Target.column).MergeArea.address '結合セルの範囲を取得
  Range(area).Borders(xlEdgeTop).Color = RGB(255, 0, 0)
  Range(area).Borders(xlEdgeBottom).Color = RGB(255, 0, 0)
  Range(area).Borders(xlEdgeLeft).Color = RGB(255, 0, 0)
  Range(area).Borders(xlEdgeRight).Color = RGB(255, 0, 0)
Else
  Cells(Target.Row, Target.column).Borders(xlEdgeTop).Color = RGB(255, 0, 0)
  Cells(Target.Row, Target.column).Borders(xlEdgeBottom).Color = RGB(255, 0, 0)
  Cells(Target.Row, Target.column).Borders(xlEdgeLeft).Color = RGB(255, 0, 0)
  Cells(Target.Row, Target.column).Borders(xlEdgeRight).Color = RGB(255, 0, 0)
End If

(とあ) 2019/12/25(水) 09:51


標準モジュールに、Public指定で変数宣言してみてください。 マクロ内でEndすると初期化されてしまいますが、普通に動作し続けている間は、プロシジャを抜けても値が保持されますよ。
(???) 2019/12/25(水) 09:58

こちらの手法が参考になるでしょう。
現在のカーソル位置を目立たせる手法として、割と有名です。
https://www.relief.jp/docs/001406.html

ただし、条件付き書式を使った時の罫線は細罫線しかなく、
しかも現在位置を示すカーソルのほうが目立つため、
赤罫線が見えません。(現状のコードもそのように思われる)
塗りつぶしとかを使ったほうが目立つのではないかと思います。

(*)当該セルだけなら、条件式は
=AND(CELL("row")=ROW(),CELL("col")=COLUMN())
となります。

(γ) 2019/12/25(水) 10:21


コード例なぞ。

1番はお手軽ですが、既に黒罫線とか利用していると一緒に消してしまうので、使いにくそう。
(元コードも同じですが)
2番は、ブックを保存してしまうと、開きなおしたときに前回値が判らないので消されない問題あり。 実用するには、どこかのセルにAddressとして書き出しておくとか、追加対策が必要。
3番の、矩形オブジェクトを使うのが安全に思いますが、いかがでしょうか。

(1)罫線全部消す

 Private Sub Worksheet_Change(ByVal Target As Range)
    Target.CurrentRegion.Cells.Borders.Color = xlNone
    With Target.MergeArea
        .Borders(xlEdgeTop).Color = RGB(255, 0, 0)
        .Borders(xlEdgeBottom).Color = RGB(255, 0, 0)
        .Borders(xlEdgeLeft).Color = RGB(255, 0, 0)
        .Borders(xlEdgeRight).Color = RGB(255, 0, 0)
    End With
 End Sub

(2)前回のセルを覚えておく

 【標準モジュール】
Public R As Range

 【シートモジュール】
 Private Sub Worksheet_Change(ByVal Target As Range)
    If Not R Is Nothing Then
        R.MergeArea.Borders.Color = xlNone
    End If
    With Target.MergeArea
        .Borders(xlEdgeTop).Color = RGB(255, 0, 0)
        .Borders(xlEdgeBottom).Color = RGB(255, 0, 0)
        .Borders(xlEdgeLeft).Color = RGB(255, 0, 0)
        .Borders(xlEdgeRight).Color = RGB(255, 0, 0)
    End With
    Set R = Target
 End Sub

(3)矩形オブジェクトで罫線引く

 Private Sub Worksheet_Change(ByVal Target As Range)
    Dim S As Shape

    With Target.MergeArea
        For Each S In ActiveSheet.Shapes
            If S.Name = "枠" Then
                S.Left = .Left
                S.Top = .Top
                S.Width = .Width
                S.Height = .Height
                Exit Sub
            End If
        Next S

        With ActiveSheet.Shapes.AddShape(msoShapeRectangle, .Left, .Top, .Width, .Height)
            .Name = "枠"
            .Fill.Visible = msoFalse
            .Line.ForeColor.RGB = RGB(255, 0, 0)
        End With
    End With
 End Sub
(???) 2019/12/25(水) 11:40

横からですが、
>単独セル、結合セルが混ざった表があるとします。
>A列〜K列のように、ある特定の場所に表が作成され
表の範囲は固定または、CurrentRegionなどで取得できますか?

>セルをクリックするとクリックしたセルの枠が赤くなるようにしてあります。
提示のコードってSelectionChangeイベントで書いてたりしませんかね?

上記2つがいずれもYESなら、こうしたらどうでしょうか?

    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
        Dim 表範囲 As Range: Set 表範囲 = Range("A2:K100")

        '▼選択(されてアクティブになった)セルが表の範囲内か判定
        If Intersect(表範囲, ActiveCell.MergeArea) Is Nothing Then Exit Sub

        '▼選択(されてアクティブになった)セルが含まれる列【全部】の罫線の色をデフォルトにする
        With Intersect(表範囲, ActiveCell.MergeArea.EntireColumn)
            .Borders.ColorIndex = xlAutomatic
        End With

        '▼選択(されてアクティブになった)セル【のみ】罫線の色を赤にする
        With ActiveCell.MergeArea
            .Borders(xlEdgeTop).Color = RGB(255, 0, 0)
            .Borders(xlEdgeBottom).Color = RGB(255, 0, 0)
            .Borders(xlEdgeLeft).Color = RGB(255, 0, 0)
            .Borders(xlEdgeRight).Color = RGB(255, 0, 0)
        End With
    End Sub

(もこな2 ) 2019/12/25(水) 12:10


私のコードだと、セルの値を削除したときにエラーになってしまったので、以下のように修正してください。
    With Target.MergeArea
   ↓
    With Range(Cells(Target.Row, Target.Column).Address).MergeArea
(???) 2019/12/25(水) 18:09

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.