Pages: [1]   Go Down

Author Topic: Excel VBA code to calculate delta E 2000  (Read 481 times)

Doug Gray

  • Sr. Member
  • ****
  • Offline Offline
  • Posts: 1374
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 Offline
  • Posts: 2
    • ColorTell CMS
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