Excel VBA での計算について…

質問

こんばんは、最近VBAを使い始めた初心者のものです。
画像処理をやってます。Bitmap形式の画像からRGB値を読み込んでそれぞれのワークシートに値を入れる所までは出来てます。
そのあと、RGB→XYZ→L*a*b*に変換した値を新しいワークシートの対応するセルにいれたいのですが、なにぶん初心者なのでどう書くのかわからず困ってます。
どなたか教えていただけないでしょうか？
ちなみにRGB→XYZの変換式は
X=0.607R+0.174G+0.201B
Y=0.299R+0.587G+0.114B
Z=0.066G+1.117B
で、XYZ→L*a*b*の変換式は
(X/0.983)>0.008856,(Y/1.000)>0.008856,(Z/1.183)>0.008856の時
L*=116(Y/1.000)^1/3
a*=500{(X/0.983)^1/3-(Y/1.000)^1/3}
b*=200{(Y/1.000)^1/3-(Z/1.183)^1/3}
(X/0.983),(Y/1.000),(Z/1.183)の値に0.008856以下のものがある場合は、
上式で対応する立法根の項をそれぞれ以下の式に置き換えて計算します。
(X/0.983)^1/3→7.787(X/0.983)+16/116
(Y/1.000)^1/3→7.787(Y/1.000)+16/116
(Z/1.183)^1/3→7.787(Z/1.183)+16/116

回答No.2

nishi6 · ベストアンサー

シートR,G,Bの変換数値の出力用に３シート（シート名はLab_L、Lab_a、Lab_b） を作成しておきます。シートを挿入してシート名をつけておきます。

X,Y,Z,L,a,b　については、どのような意味合いの数値か分かりませんので　Double　で計算しています。
一応、L,a,b　の値は計算できていますが、値の妥当性はまるっきり分かりません。

シートR,G,Bの『同じセル番地をセットで変換』するという理解で、変換の仕方を書いてみました。
シートRのセルを参照して、同じ番地のシートG,Bの値を使い、変換結果をシートLab_L、Lab_a、Lab_b　の同じ番地に書き込んでいます。X,Y,Z　はモジュールの中だけで使用しています。

ご参考に。

標準モジュールに貼り付けます（当方、Excel2000です）
↓
Public Sub HENKANN()
　　Dim wsR, wsG, wsB As Worksheet　　　　　　　　'RGBシート
　　　　Set wsR = Worksheets("R")　　　　　　　　　'シートR
　　　　Set wsG = Worksheets("G")　　　　　　　　　'シートG
　　　　Set wsB = Worksheets("B")　　　　　　　　　'シートB

　　Dim wsLab_L, wsLab_a, wsLab_b As Worksheet　 'Labシート
　　　　Set wsLab_L = Worksheets("Lab_L")　　　　　'シートLab_L
　　　　Set wsLab_a = Worksheets("Lab_a")　　　　　'シートLab_a
　　　　Set wsLab_b = Worksheets("Lab_b")　　　　　'シートLab_b

　　Dim rg As Range　　　　　　　　　　　　　　　'計算するセル
　　Dim Adr As String　　　　　　　　　　　　　　'計算するセルの番地
　　Dim X, Y, Z, L, a, b As Double　　　　　　　 'X,Y,Z と計算したL,a,b

　　Application.ScreenUpdating = False
　　'シートRのセルを順に計算対象として、この値と
　　'　　対応するシートG,Bの値からX,Y,Z とL,a,bを計算
　　For Each rg In wsR.Range("A1:IV256")
　　　　'RGB→XYZの変換
　　　　Adr = rg.Address　　'セルの番地
　　　　X = (0.607 * wsR.Range(Adr) + 0.174 * wsG.Range(Adr) + 0.201 * wsB.Range(Adr)) / 255
　　　　Y = (0.299 * wsR.Range(Adr) + 0.587 * wsG.Range(Adr) + 0.114 * wsB.Range(Adr)) / 255
　　　　Z = (0.066 * wsG.Range(Adr) + 1.117 * wsB.Range(Adr)) / 255

　　　　'XYZ→Labの変換
　　　　If (X / 0.983 > 0.008856) And (Y > 0.008856) And (Z / 1.183 > 0.008856) Then
　　　　　　L = 116 * Y ^ (1 / 3)
　　　　　　a = 500 * ((X / 0.983) ^ (1 / 3) - Y ^ (1 / 3))
　　　　　　b = 200 * (Y ^ (1 / 3) - (Z / 1.183) ^ (1 / 3))
　　　　Else
　　　　　　L = 903.3 * Y
　　　　　　a = 500 * (7.787 * (X / 0.983) + 16 / 116 - (7.787 * Y + 16 / 116))
　　　　　　b = 200 * (7.787 * Y + 16 / 116 - (7.787 * (Z / 1.183) + 16 / 116))
　　　　End If

　　　　'Labの各シートに書き出し
　　　　wsLab_L.Range(Adr) = L
　　　　wsLab_a.Range(Adr) = a
　　　　wsLab_b.Range(Adr) = b
　　Next
　　Application.ScreenUpdating = True
End Sub

回答No.1

TAGOSAKU7

質問の意味が全く理解できてません。

>そのあと、RGB→XYZ→L*a*b*に変換した値を新しいワークシートの対応するセルにいれたいのですが、なにぶん初心者なのでどう書くのかわからず困ってます。

XYZ?
L*a*b?
全く意味不明です。

X=0.607R+0.174G+0.201B
Y=0.299R+0.587G+0.114B
Z=0.066G+1.117B
とは？
0.607R = 0.607 * R
ですか？数学的記述をするのではなく、プログラミング的記述で質問を行ってください。

＞対応するセル
対応の法則がわかりません。

補足

すみません、補足します。
すべて色を表す表色系のことです。
画像処理をやってます。Bitmap形式の画像からRGB値を読み込んでそれぞれのワークシート"R"、"G"、"B”に画素毎に値を読み込んでます。
最終的にL*a*b*表色系の値が欲しいのでRGB表色系→XYZ表色系→L*a*b*表色系の手順で値を変換しなくてはなりません。
それが下記の計算です。

まずはRGB→XYZへの変換です（以前の式とは変わってます）
X =（0.607 * R + 0.174 * G + 0.201 * B）/ 255
Y =（0.299 * R + 0.587 * G + 0.114 * B）/ 255
Z =（0.066 * G + 1.117 * B）/ 255
で、XYZ→L*a*b*への変換は
(X/0.983)>0.008856,(Y/1.000)>0.008856,(Z/1.183)>0.008856の時
L = 116 * (Y/1.000)^(1/3）
a = 500 * [(X/0.983)^(1/3) - (Y/1.000)^(1/3)]
b = 200 * [(Y/1.000)^(1/3) - (Z/1.183)^(1/3)]
(X/0.983),(Y/1.000),(Z/1.183)の値に0.008856以下のものがある場合は、
L = 903.3 * Y
a = 500 * [7.787 * (X/0.983) + 16/116 - (7.787 * (Y/1.000) + 16/116)]
b = 200 * [7.787 * (Y/1.000) + 16/116 - (7.787 * (Z/1.183) + 16/116)]
となります。
おおもとのR、G、Bのデータはそれぞれ256×256個あって、0～255までの整数です。
いかがでしょうか？