[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『条件付書式で設定しているセル背景色の取得』（yama）
条件付き書式で色をつけてるんだから
同様にその「条件」を用いて色を取得すればいいような・・・
(GobGob)
参照しているスレのコードはセルに色がついている場合のコード。 条件付き書式の色は、セルを見てもわからない。GobGobさんのコメントの通り、その条件から色を作り出す必要がある。 A1に設定した条件を具体的に説明すれば、いろいろ解決方法のアドバイスがあるとおもうよ。
追記）とりあええず、今、思いつくのは
１．A3の色を、今、A1につけられている色と同じにしたいということなら、A3にもA1と同じ条件付き書式をセットする。 必要なら、これをマクロでやることもできるかな？ ２．GobGobさんがアドバイスされる方法。たとえば、A1に設定されている条件が セルの値が100以下なら緑、100超なら黄色 なのであれば、A1の値によっていずれかの色をつけるマクロをつくる。 ３．A1に設定されている条件そのものを、マクロで評価して、その条件の中で｢真｣になるものにたいし その条件で指定されている背景色をつける。これは、結構骨の折れることになるけど http://www.keep-on.com/excelyou/2000lng4/200005/00050350.txt http://www.moug.net/tech/exvba/0110009.html http://www.moug.net/tech/exvba/0110017.html http://www.moug.net/tech/exvba/0110018.html
(ぶらっと)
＞A1に設定した条件を具体的に説明すれば、いろいろ解決方法のアドバイスがあるとおもうよ。
下記となりますので御指導お願いします。
条件付書式は次となります。
B2からB10まで4つの条件付書式
=$A2=10の時 赤
=$A2=8の時 黄
=$A2=6の時 緑
=$A2=4の時 青
sheet1
A B
1
2 10 1(赤)
3 10 3(赤)
4 8 5(黄)
5 4 2(青)
6 6 6(緑)
7 6 9(緑)
8 6 2(緑)
9 8 10(黄)
10 4 4(青)
((ぶらっと)さんのマクロを追記)
Sub Sample()
Dim c As Range
Dim sh1 As Worksheet
Dim i As Long
Dim j As Long
Application.ScreenUpdating = False
Set sh1 = Sheets("Sheet1")
With Sheets("Sheet2")
.Cells.Clear
For Each c In sh1.Range("B1", sh1.Range("B" & sh1.Rows.Count).End(xlUp))
If Not IsEmpty(c.Value) Then
i = ((c.Value - 1) Mod 5) + 1
j = ((((c.Value - 1) \ 5) + 2) - 1) * 2
With .Cells(i, j)
.Value = c.Value
★ ここを変えるのでしょうか？→ .Interior.Color = c.Interior.Color
.Offset(, 1).Interior.Color = .Interior.Color
End With
End If
Next
.Select
End With
Set sh1 = Nothing
Application.ScreenUpdating = True
MsgBox "組み替え完了"
End Sub
（yama）
参照してくれている私のコードは、転記先等、あちらの要件があってややこしいので、 B2:B○ までの 領域に対し、そこで設定されている条件付書式による背景色をC列に（値とともに）セットするコードにした。
↑で提案した、条件付書式そのもののコピーは、条件が「セルの値が」なら、コードとしては一番簡単。 (というか、コードも不要かな。B列の領域をコピーし、C列に値を選択して貼付け(書式) でＯＫ） だけど、「数式が」の場合は、ちょっと面倒なのでパス。
Sample1 + GetColor は、説明のあった条件をコードの中で判定。 Sample2 + GetColorRGB は、紹介した http://www.keep-on.com/excelyou/2000lng4/200005/00050350.txt この中の GetColorRGB を使う方法。 GetColorRGB を、そのままコピペすると 構文エラーで赤く光るコードがいくつかある。 これらコードの、先頭の " を消して。で、それでも赤く光るコードがあるので、そのコードについては コード末尾の " を消して。
コードとしては Sample2 のほうが短いけど、条件は固定。 Sample3は、どんな条件が設定されていたとしても対応（するらしい）
Sub Sample1()
Dim c As Range
Dim sh1 As Worksheet
Dim i As Long
Dim j As Long
Dim myColor As Long
Application.ScreenUpdating = False
Set sh1 = Sheets("Sheet1")
sh1.Columns("C").Clear
For Each c In sh1.Range("B2", sh1.Range("B" & sh1.Rows.Count).End(xlUp))
If Not IsEmpty(c.Value) Then
c.Offset(, 1).Value = c.Value 'C列に値を転記
myColor = GetColor(c)
If myColor <> 0 Then c.Offset(, 1).Interior.Color = myColor 'C列の背景色をセット
End If
Next
Set sh1 = Nothing
Application.ScreenUpdating = True
MsgBox "色付け完了"
End Sub
Function GetColor(c As Range) As Long
Select Case c.Offset(, -1).Value 'A列の値
Case 10: GetColor = vbRed
Case 8: GetColor = vbYellow
Case 6: GetColor = vbGreen
Case 4: GetColor = vbBlue
End Select
End Function
Sub Sample2()
Dim c As Range
Dim sh1 As Worksheet
Dim i As Long
Dim j As Long
Dim myColor As Long
Application.ScreenUpdating = False
Set sh1 = Sheets("Sheet1")
sh1.Columns("C").Clear
For Each c In sh1.Range("B2", sh1.Range("B" & sh1.Rows.Count).End(xlUp))
If Not IsEmpty(c.Value) Then
c.Offset(, 1).Value = c.Value 'C列に値を転記
myColor = GetColorRGB(c)
If myColor <> 0 Then c.Offset(, 1).Interior.Color = myColor 'C列の背景色をセット
End If
Next
Set sh1 = Nothing
Application.ScreenUpdating = True
MsgBox "色付け完了"
End Sub
Function GetColorRGB(ByVal aCell As Range) As Long 'コードは省略するのでコピペしてね。 End Function
(ぶらっと)
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.