【100Pスタート】ExcelのVBAマクロ作成に関する質問です。セルの色を条件により変えたいと思っています。たぶん簡単だと思うのですが、なにせVBA作成がド素人なため、アドバイスいただければ幸いです。質問等はリンク先のファイルを参照いただけるとわかりやすいかと思います。対象となるセルはB13〜CW112の10000個のセルです。

urlは無関係

素性のわからないマクロ付きexcelファイルなど開く気もないので詳細不明ですが、

条件付き書式では実現不可能？

メニューバーの書式というところを開いて

　条件付き書式　というものを選択します。

条件に合わせて文字の色、セルの色をかえることが出来ます。

がんばってください。

条件付書式を使うのでしたらこんな風に

自動記録でやってみたい操作をして

記録されたマクロの該当位置に条件をつける方法もあります

自動記録の詳細

マクロの場合はどういう場合に実行させるか決める必要があります

（ボタンを押したら色を変えるのか、どこかセルが変更されたら変えるのか・・など）

セルの値を参照する方法です

モジュールじゃなくても、セルの色を条件で変えられます。

一応参考まで。

あと、マクロつきのファイルを参照するのはウイルス付きの可能性が０とはいえないので怖いです。VBAのソースを表示してくれたほうがよいかなと思います。では。

とりあえず、一番目のを作りました。

55までと決まっているなら、for〜nextでもよいのですが、一応空白までとしました。

Sub macroX()

Dim i As Integer

Dim j As Integer

i = 2 ’(12,2)=B12から

j = 13 ’(1,13)=A13から

Sheets(”回線数算出”).Activate

Do Until Cells(12, i).Value = ””

Do Until Cells(j, 1).Value = ””

If Cells(12, i).Value = Cells(j, 1).Value Then

Cells(j, i).Select

With Selection.Interior

.ColorIndex = 1

End With

End If

j = j + 1

Loop

i = i + 1

j = 13

Loop

End Sub

長いですが、（２）のほうです。

Sub macroXX()

Dim i, j, ii, jj As Integer

Dim escapeSW As Boolean

Dim groupI As Integer

Dim groupJ As Integer

i = 2

j = 13

escapeSW = False

Sheets(”回線数算出”).Activate

Do Until Cells(12, i).Value = ””

Do Until Cells(j, 1).Value = ””

jj = 1

ii = 1

’横の自然数のグループを求める

For jj = 1 To 10

For ii = 1 To 10

If Cells(12, i).Value = Cells(jj, ii).Value Then ’(jj,ii)はエリア番号設定の表（A1からJ10）まで

groupI = Cells(jj, ii + 22).Value ’左の表から22を足すとグループ設定の表

escapeSW = True ’省略可（見つかった時点で探すのをやめるため）

Exit For ’省略可

End If

Next

If escapeSW = True Then ’省略可

escapeSW = False ’省略可

Exit For ’省略可

End If ’省略可

Next

’以下、縦の自然数のグループ（同じ考え）

For jj = 1 To 10

For ii = 1 To 10

If Cells(j, 1).Value = Cells(jj, ii).Value Then

groupJ = Cells(jj, ii + 22).Value

escapeSW = True

Exit For

End If

Next

If escapeSW = True Then

escapeSW = False

Exit For

End If

Next

’一致したセルを塗る

Cells(j, i).Select

With Selection

If groupI = groupJ Then

Selection.Interior.ColorIndex = 7

Else

Selection.Interior.ColorIndex = xlNone

End If

End With

j = j + 1

Loop

i = i + 1

j = 13

Loop

End Sub

URLはダミーです。

左端の表の値と3つ目の表の値を関連付けるためにdata配列を作りました。

自然数の値が、１から10000であると仮定して配列は作っています。

data(11) = 1

data(12) = 1

data(13) = 1

...

の配列を作成し

セルの(m,n)のdata(m)とdata(n)が等しいかどうかを調べています。

それ以外は、「透明」にというところは、よくわからなかったので記述していません。

ご質問の回答になっていますでしょうか？

Cellに色をつける方法がわからず手間取ってしまいました。

Sub sub1()

Dim i As Integer

Dim j As Integer

Dim k As Integer

Dim data(10000) As Integer

k = 0

For i = 1 To 10

For j = 1 To 10

If Not IsEmpty(Cells(i, j)) Then

data(Cells(i, j)) = Cells(i, j + 22)

k = k + 1

End If

Next j

Next i

For i = 1 To k

For j = 1 To k

If i = j Then

Range(Cells(i + 12, j + 1), Cells(i + 12, j + 1)).Interior.ColorIndex = 1

ElseIf data(Cells(i + 12, 1)) = data(Cells(12, j + 1)) Then

Range(Cells(i + 12, j + 1), Cells(i + 12, j + 1)).Interior.ColorIndex = 22

Else

Rem 透明

End If

Next j

Next i

End Sub