dポイントプレゼントキャンペーン実施中!

こんばんは、最近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

A 回答 (2件)

シートR,G,Bの変換数値の出力用に3シート(シート名は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
    • good
    • 0

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



>そのあと、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までの整数です。
いかがでしょうか?

補足日時:2001/12/17 11:21
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!