色度(x,y)をスペクトルデータから計算したいです。

質問

色度(x,y)をスペクトルデータから計算したいです。
任意のスペクトルデータを入力し色度(x,y)を計算したいです。
EXCELやフリーのソフトで、その様なことができるものはありますか？

回答No.3

inara · ベストアンサー

もしマクロの作り方が分からなければ以下の手順を参考にしてください。
【マクロの作成方法】
　　　(1)　Excelワークシートを新規に作成し、ALTキーを押しながら F8 キーを押す
　　　(2)　マクロ名の欄に適当なマクロ名（xy など）を書いて「作成」をクリック
　　　(3)　Visual Basicの編集画面の Sub マクロ名() と End Sub の間にコードを貼り付ける（回答No.2ののプログラムの Sub xy() と End Sub の間の文章を コピー＆ペースト すれば良い）
　　　(4)　編集画面を閉じる（ALT+Q）

【マクロの実行方法】
実行する前にワークシートのセルに必要なデータが書き込まれていないとエラーになります
　　　(1)　Excelワークシートに戻り、ALTキーを押しながら F8 キーを押す
　　　(2)　作成したマクロ名を選んで「実行」をクリック

【マクロの内容の変更方法】
　　　(1)　ALTキーを押しながら F8 キーを押す
　　　(2)　作成したマクロ名を選んで「編集」をクリック
　　　(3)　内容を変更する（編集画面のままでF5キーを押すと変更されたマクロが実行されます）

【セキュリティレベルの変更】
マクロを含むExcelファイルを開くとき、セキュリティレベルによってはマクロが実行できない場合があります。その場合、以下の手順でセキュリティレベルを変更してください。
（Excel 2003の場合）
　　　新規にワークシートを作成して、ツールバーの「ツール」→「オプション」→「セキュリティー」タブ→「マクロセキュリティー」→セキュリティーレベルの「中」または「低」の選択→OK→OK→Excel終了→マクロを含むExcelファイルを開く
（Excel 2007の場合）
　　　新規にワークシートを作成して、左上隅の丸（Officeボタン）をクリック→下端の「Excelのオプション」を選択→左側の「セキュリティーセンター」を選択→右下の「セキュリティーセンターの設定」をクリック→左側の「マクロの設定」をクリック→「すべてのマクロを有効にする」を選択→OK→OK→Excelの終了（保存しない）→マクロを含むExcelファイルを開く

回答No.2

inara

VBAコードを添付します。

Sub xy()
Dim xI As Integer, xJ As Integer, yI As Integer, yJ As Integer
Dim I1 As Integer, I2 As Integer, I3 As Integer, I4 As Integer
Dim J1 As Integer, J2 As Integer, J3 As Integer, J4 As Integer, J5 As Integer, J6 As Integer
'
xI = 4 ' xの値を書き込むセルの行番号
xJ = 10 ' xの列番号
yI = 5 ' yの値を書き込むセルの行番号
yJ = 10 ' yのの列番号
'
I1 = 8 ' 等色関数データの開始行番号
I2 = 478 ' 最終行番号
J1 = 1 ' 等色関数の波長データの列番号
J2 = 2 ' 等色関数のx_データの列番号
J3 = 3 ' 等色関数のy_データの列番号
J4 = 4 ' 等色関数のz_データの列番号
'
I3 = 8 ' スペクトルデータの開始行番号
I4 = 608 ' 最終行番号
J5 = 6 ' スペクトルの波長データの列番号
J6 = 7 ' スペクトルの強度データの列番号
'
Dim w1() As Single, x1() As Single, y1() As Single, z1() As Single ' 等色関数の 波長(w1)、関数値（x1,y1,z1)
Dim w2() As Single, p() As Single, x2() As Single, y2() As Single, z2() As Single ' スペクトルの波長(w2)、強度(p)、波長に対応する等色関数値（x2,y2,z2)
Dim N1 As Integer, N2 As Integer ' N1：等色関数のデータ数、N2：スペクトルのデータ数
N1 = I2 - I1 + 1: N2 = I4 - I3 + 1
ReDim w1(N1), x1(N1), y1(N1), z1(N1)
ReDim w2(N2), p(N2), x2(N2), y2(N2), z2(N2)
Dim i As Integer, j As Integer, k As Integer, j0 As Integer, a As Single
' ---- データ読み込み
For i = 1 To N1
k = I1 + i - 1
w1(i) = Cells(k, J1): x1(i) = Cells(k, J2): y1(i) = Cells(k, J3): z1(i) = Cells(k, J4)
Next i
For i = 1 To N2
k = I3 + i - 1
w2(i) = Cells(k, J5): p(i) = Cells(k, J6)
Next i
' ---- 等色関数の補間
For i = 1 To N2
For j = 1 To N1
If w2(i) < w1(j) Then
j0 = j - 1
Exit For
End If
Next j
a = (w2(i) - w1(j0)) / (w1(j0 + 1) - w1(j0))
x2(i) = a * (x1(j0 + 1) - x1(j0)) + x1(j0)
y2(i) = a * (y1(j0 + 1) - y1(j0)) + y1(j0)
z2(i) = a * (z1(j0 + 1) - z1(j0)) + z1(j0)
Next i
' ---- 三刺激値の計算（台形公式による数値積分）
Dim sx As Single, sy As Single, sz As Single, x As Single, y As Single
sx = 0: sy = 0: sz = 0
For i = 1 To N2 - 1
a = (w2(i + 1) - w2(i)) / 2
sx = sx + (p(i) * x2(i) + p(i + 1) * x2(i + 1)) * a
sy = sy + (p(i) * y2(i) + p(i + 1) * y2(i + 1)) * a
sz = sz + (p(i) * z2(i) + p(i + 1) * z2(i + 1)) * a
Next i
x = sx / (sx + sy + sz)
y = sy / (sx + sy + sz)
Cells(xI, xJ) = x
Cells(yI, yJ) = y
End Sub

回答No.1

inara

以前、Excel VBA を使って任意のスペクトルの色度座標を計算するツールを作ったことがあるのでコードを紹介します（字数制限でこの回答に添付できないので次の解答に添付します）。ワークシートの F 列にスペクトルの波長データ、G 列にスペクトルの強度データを貼り付けて、マクロ xy を実行すると、4行 J 列目に x 座標、5 行 J 列目に y 座標の値が書き込まれます。

データの読書きのセル位置はプログラムの4行目以降に書かれていますので適宜変えてください。添付図は、発光スペクトルをローレンツ関数とした場合の例です。このVBAプログラムは自分用なのでエラー処理等は行っていません。スペクトルの波長範囲は、等色関数データの波長範囲の内側としてください。スペクトルの波長が中途半端な値でも、波長間隔が一定でなくても計算できます（等色関数を直線補間している）。

等色関数データは、ここ（http://www.cvrl.org/）の左側の「CMFs」をクリックして出てきたページの「E/W」をクリックするとダウンロードできます。一番上にある 「CIE 1931 2-deg, XYZ CMFs」 が2度視野、「CIE 1964 10-deg, XYZ CMFs 」が10度視野です。「E/W」の / が破線のほうは波長 5nm 刻み、/ が実線のほうが 1nm 刻みのデータです。ダウンロードしたデータの1列目は波長、2列目が等色関数の x_、3列目が y_、4列目が z_ になっています。