[[20170224181045]] 『図表の指定の場所に色を付ける方法』(いちか) ページの最後に飛ぶ

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

 

『図表の指定の場所に色を付ける方法』(いちか)

下の様な図表があります

  A B C D E F G

1   ア イ ウ エ オ カ  以下ナまで

2 A

3 B

4 C

5 D

6 E

以下Lまで
 

<教えて頂きたい事>

例えば、B20セルにE、C20セルにカ、と入力した時に、上記図表の

『Eカ』(セル6G)のマスに、青色が付く様にしたいのですが、

いい方法はないでしょうか?


条件付き書式で。

=AND($A2=$B$20,B$1=$C$20)

(マナ) 2017/02/24(金) 20:17


マナさんへ

何とか完成出来ました、ありがとうございます。(いちか)
(いちか) 2017/02/24(金) 21:06


 ワークシートのコード記述欄に記述!

 Option Explicit

 Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 2 Then Exit Sub
    If Intersect(Target, Range("B20:C20")) Is Nothing Then Exit Sub
    Dim sh As Worksheet
    Set sh = ThisWorkbook.ActiveSheet

    If Not (Len(Trim(sh.Range("B20"))) <> 0 And _
            Len(Trim(sh.Range("C20"))) <> 0) Then Exit Sub

    Dim fc As Long, fr As Long
    fc = sh.Cells(1, Columns.Count).End(xlToLeft).Column
    fr = sh.Cells(Rows.Count, "A").End(xlUp).Row
    Dim myRng1 As Range, myRng2 As Range, myRng3 As Range
    Set myRng1 = sh.Range(sh.Cells(1, 1), sh.Cells(1, fc))
    Set myRng2 = sh.Range(sh.Cells(1, 1), sh.Cells(fr, 1))
    Set myRng3 = sh.Range(sh.Cells(2, 2), sh.Cells(fr, fc))
    myRng3.Interior.Pattern = xlNone
    Dim c As Long, r As Long
    c = WorksheetFunction.Match(sh.Range("C20"), myRng1, 0)
    r = WorksheetFunction.Match(sh.Range("B20"), myRng2, 0)
    Dim ad As Range
    Set ad = sh.Range(sh.Cells(r, c), sh.Cells(r, c))
    ad.Interior.Color = RGB(0, 0, 255)
    Set sh = Nothing: Set myRng1 = Nothing
    Set myRng2 = Nothing: Set myRng3 = Nothing
 End Sub
(マリオ) 2017/02/24(金) 21:13

コメント返信:

[ 一覧(最新更新順) ]


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