Pages: [1]   Go Down

### AuthorTopic: Excel VBA code to calculate delta E 2000  (Read 482 times)

#### Doug Gray

• Sr. Member
• Offline
• Posts: 1375
##### Excel VBA code to calculate delta E 2000
« on: June 18, 2018, 06:56:06 PM »

Seems many use Excel and the formula for deltaE2000 is obtuse at best so I thought I'd drop this off. Here's an Excel function that calculates dE00. Select developer then click the Visual Basic icon on the top left. Create a "module" for your spreadsheet if you don't already have one then past this code in it:

' call like this in Excel: where L1 is the L* value of patch1 and L2 is the L* values of patch2, etc.
' =deltaE2000(L1,a1,b1, L2,a2,b2)
' deltaE2000(80,0,90, 80,0,95) yields .9685 which shows dE00 compression at high saturation
Public Function deltaE2000(Lstd As Double, astd As Double, bstd As Double, Lsample As Double, asample As Double, bsample As Double)
Pi = 4 * Atn(1)
cabarithmean = (Sqr(astd ^ 2 + bstd ^ 2) + Sqr(asample ^ 2 + bsample ^ 2)) / 2
G = 0.5 * (1 - Sqr(cabarithmean ^ 7 / (cabarithmean ^ 7 + 25 ^ 7)))
'x = WorksheetFunction.Atan2(2, 3)
apstd = (1 + G) * astd
apsample = (1 + G) * asample

Cpsample = Sqr(apsample ^ 2 + bsample ^ 2)
Cpstd = Sqr(apstd ^ 2 + bstd ^ 2)
Cpprod = Cpsample * Cpstd
zcidx = Cpprod = 0
hpstd = WorksheetFunction.Atan2(apstd + 0.00000000001, bstd)
hpstd = hpstd - 2 * Pi * (hpstd < 0)

If (Abs(apstd) + Abs(bstd) = 0) Then
hpstd = 0
End If

hpsample = WorksheetFunction.Atan2(apsample + 0.000000001, bsample)

hpsample = hpsample - 2 * Pi * (hpsample < 0)
If (Abs(apsample) + Abs(bsample) = 0) Then
hpsample = 0
End If
dL = (Lsample - Lstd)
dC = Cpsample - Cpstd
dhp = hpsample - hpstd
dhp = dhp + 2 * Pi * (dhp > Pi)
dhp = dhp - 2 * Pi * (dhp < (-Pi))
If (zcidx) Then
dhp = 0
End If

dH = 2 * Sqr(Cpprod) * Sin(dhp / 2)
Lp = (Lsample + Lstd) / 2
Cp = (Cpstd + Cpsample) / 2
hp = (hpstd + hpsample) / 2
hp = hp - (Abs(hpstd - hpsample) > Pi) * Pi
hp = hp - (hp < 0) * 2 * Pi
If (zcidx) Then
hp = hpsample + hpstd
End If

Lpm502 = (Lp - 50) ^ 2
Sl = 1 + 0.015 * Lpm502 / Sqr(20 + Lpm502)
Sc = 1 + 0.045 * Cp

Tx = 1 - 0.17 * Cos(hp - Pi / 6) + 0.24 * Cos(2 * hp) + 0.32 * Cos(3 * hp + Pi / 30) - 0.2 * Cos(4 * hp - 63 * Pi / 180)
Sh = 1 + 0.015 * Cp * Tx
delthetarad = (30 * Pi / 180) * Exp(-(((180 / Pi * hp - 275) / 25) ^ 2))
Rc = 2 * Sqr((Cp ^ 7) / (Cp ^ 7 + 25 ^ 7))

RT = -Sin(2 * delthetarad) * Rc
kl = 1
kc = 1
kh = 1
klSl = kl * Sl
kcSc = kc * Sc
khSh = kh * Sh
de00 = Sqr((dL / klSl) ^ 2 + (dC / kcSc) ^ 2 + (dH / khSh) ^ 2 + RT * (dC / kcSc) * (dH / khSh))
deltaE2000 = de00
End Function
Logged

#### muyisoldier54

• Newbie
• Offline
• Posts: 2
##### Re: Excel VBA code to calculate delta E 2000
« Reply #1 on: September 14, 2018, 08:32:02 PM »

BTW, you can use the calculator online by CT website, as bellow:
https://www.colortell.com/colorde
Logged
Pages: [1]   Go Up