[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『図表の指定の場所に色を付ける方法』(いちか)
下の様な図表があります
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.