EXCEL スマートにセルの値をコピペしたい

質問

EXCEL2003を利用しています。

写真のようにとある表があります。（範囲A2:K7セルとします）

この表は、タイトル枠を除いて、水色、赤色、白色の３色の背景色があります。

この表の行から、値をひとつ選んで、新たに表を作成します。（範囲A11:K12とします）

値を選ぶルールは下記の通りです。
　・ルール１　白いセルがあれば、そのセルの値を採用する。
　・ルール２　白いセルがなければ、青いセルの値を採用する
　・ルール３　白いセルも青いセルもなければ、赤いセルの値を採用する
　・ルール４　Ｎｏは出来るだけ小さい値であること

この作業を延々と手作業で行っており、VBAで行おうとするも、しっくりとしたものができませんでしたので、投稿させていただきました。
どうか、良いお知恵を授けていただきたいです。よろしくお願いいます。

回答No.5

kkkkkm · ベストアンサー

No3です。

画像を見ると採用したセルの色も12行目に反映させているのですね。以下のように追加してください。ほかの色も同じようにしてください。

以下は青の場合です。(画像では水色ですが、ルールでは青と書かれているのでとりあえず青としておきます。実際のRGBは先の回答で示した方法で確認してください)

If Cells(j, i).Interior.Color = RGB(0, 0, 255) Then
Cells(12, i).Value = Cells(j, i).Value
Cells(12, i).Interior.Color = RGB(0, 0, 255)

以下のようにもできますが変更が2項目ぐらいなので上記でも面倒では無いと思います。
With Cells(12, i)
.Value = Cells(j, i).Value
.Interior.Color = RGB(0, 0, 255)
End With

お礼

ご親切に補足ありががとうございました。
迷いましたが、セルの色のサポートをいただけたので、ベストアンサーとさせていただきます。

回答No.4

tom04

何度もごめんなさい。
ちゃんと質問文に
＞水色、赤色、白色の３色の背景色があります
と記載されていましたね。
どうも失礼しました。

コード内のカラーインデックス番号を
青　5　を　8（水色）に変更してください。
ちなみに「赤」は　3　です。

※　カラーインデックスに関しては言葉でいう「水色」でも見方によっては
「薄い青」も水色と言えるかもしれませんので　41　などが「薄い青」となります。
PCは融通が利きませんので、詳しくはカラーインデックスで検索してみてください。m(_ _)m

お礼

ご親切に補足ありがとうございました。

回答No.3

kkkkkm

あまりスマートとは言えませんが

Sub Example()
Dim i As Integer, j As Integer
Dim WhiteFG As Boolean, BlueFG As Boolean

For i = Range("B2").Column To Range("K2").Column
WhiteFG = False
BlueFG = False
For j = 3 To 7
If Cells(j, i).Interior.Color = RGB(255, 255, 255) Then
Cells(12, i).Value = Cells(j, i).Value
WhiteFG = True
Exit For
End If
Next j
If WhiteFG = False Then
For j = 3 To 7
If Cells(j, i).Interior.Color = RGB(0, 0, 255) Then
Cells(12, i).Value = Cells(j, i).Value
BlueFG = True
Exit For
End If
Next j
If BlueFG = False Then
For j = 3 To 7
If Cells(j, i).Interior.Color = RGB(255, 0, 0) Then
Cells(12, i).Value = Cells(j, i).Value
Exit For
End If
Next j
End If
End If
Next
End Sub

RGBの値は塗りつぶしたセルの書式の色の設定で、その他の色からユーザー設定を見るとRGBそれぞれの数値が出ていますのでそれに合わせてください。

お礼

回答ありがとうございます。
とても見やすくて、しっくりと理解できてよかったです。

回答No.2

tom04

No.1です。
たびたびごめんなさい。
画像にあるルール4に関して・・・

＞NOは出来るだけ小さい値であること

というコトはその色の最初に出現したデータというコトですかね？
前回は同じ色でも最小の値を表示するようにしていましたので、
そうであれば全く異なったデータが表示されます。
↓のコードに変更してみてください。

Sub Sample2()
Dim j As Long, i As Long, myFlg As Boolean
For j = 2 To Cells(2, Columns.Count).End(xlToLeft).Column
Cells(12, j) = ""
myFlg = False
For i = 3 To 7
If Cells(i, j).Interior.ColorIndex = 2 Then
Cells(12, j) = Cells(i, j)
myFlg = True
Exit For
End If
Next i
If myFlg = False Then
For i = 3 To 7
If Cells(i, j).Interior.ColorIndex = 5 Then
Cells(12, j) = Cells(i, j)
myFlg = True
Exit For
End If
Next i
End If
If myFlg = False Then
For i = 3 To 7
If Cells(i, j).Interior.ColorIndex = 3 Then
Cells(12, j) = Cells(i, j)
Exit For
End If
Next i
End If
Next j
End Sub
。
今度はどうでしょうか？m(_ _)m

お礼

回答ありがとうございました。
私がイメージしていた感じのものに、もっとも近くて理解しやすかったです。

回答No.1

tom04

こんばんは！

セルの色は条件付き書式での色付けではないのですね？
手作業で色付けされているという前提です。

白　→　カラーインデックスの　2
青　→　カラーインデックスの　5
とします。
（青が水色などの場合はカラーインデックスの番号を変更する必要があります）

シートモジュールです。
↓のコードをコピー＆ペーストしてマクロを実行してみてください。

Sub Sample1()
Dim j As Long, i As Long
Dim myValW, myValB, myValR
For j = 2 To Cells(2, Columns.Count).End(xlToLeft).Column
myValW = ""
myValB = ""
myValR = ""
For i = 3 To 7
Select Case Cells(i, j).Interior.ColorIndex
Case 2
If myValW = "" Then
myValW = Cells(i, j)
Else
myValW = WorksheetFunction.Min(myValW, Cells(i, j))
End If
Case 5
If myValB = "" Then
myValB = Cells(i, j)
Else
myValB = WorksheetFunction.Min(myValB, Cells(i, j))
End If
Case Else
If myValR = "" Then
myValR = Cells(i, j)
Else
myValR = WorksheetFunction.Min(myValR, Cells(i, j))
End If
End Select
Next i
If myValW <> "" Then
Cells(12, j) = myValW
ElseIf myValB <> "" Then
Cells(12, j) = myValB
Else
Cells(12, j) = myValR
End If
Next j
End Sub

※　もっと簡単に出来るかもしれませんが、
こんな感じではどうでしょうか？m(_ _)m