氩气物性计算-源代码-VBA-加载宏-可以在Excel单元格里直接调用：在Excel后台里插入模块，然后输入下面代码，就可以在前面Excel单元格里调用计算氩气物性的函数进行物性计算了

'氩气

'常数

Const R = 208.12 'J/kg.K，气体常数

Const M = 0.039944 'kg/mol，氩气的分子量

Const Pcr = 5 'MPa，临界压力

Const roucr = 536 'kg/m3，临界密度

Const tb = -185.86 '℃，沸点

Const tm = -189.37  '℃，熔点

'Const cp0 = 5198 'J/kg.K

'Const cv0 = 3121 'J/kg.K

Const h0 = -330 'J/kg 温度315.56℃，压力0.1013MPa时氩气的焓

Const s0 = 2189.5 'J/kg.K 温度315.56℃，压力0.1013MPa时氩气的熵

Const T0 = 273.15 'K

Const p0 = 100000 'Pa

'Const rou0 = 0.1762 'kg/m3

'1.比容计算，m3/kg

Function f_vpT_Ar(V, P, T) 'p-MPa,T-K,v-m3/kg

    Dim A0, a, B0, b, c

        A0 = 81.033

        a = 0.000583312

        B0 = 0.000984966

        b = 0

        c = 1500.88

        'p = p * 1000000

      Dim f

    f = ((R * T * (1 - c / (V * T ^ 3))) / (V ^ 2)) * (V + B0 * (1 - b / V))

    f = f - (1 - a / V) * A0 / V ^ 2

    f_vpT_Ar = f - P

    'f = f

    On Error Resume Next

      

End Function

'比容，m3/kg

Function V_PT_Ar(P, T)

    Dim vi(10000)

    vi(1) = 0.01

    vi(2) = 2

    WuCha = 0.00001

   

    If f_vpT_Ar(vi(1), P, T) <> 0 And f_vpT_Ar(vi(2), P, T) Then

    vi(3) = vi(2) - f_vpT_Ar(vi(2), P, T) * (vi(2) - vi(1)) / (f_vpT_Ar(vi(2), P, T) - f_vpT_Ar(vi(1), P, T))

    'Debug.Print "vi(3)="; vi(3)

    'v = vi(3)

    End If

   

   

    If f_vpT_Ar(vi(2), P, T) <> 0 And f_vpT_Ar(vi(3), P, T) Then

    vi(4) = vi(3) - f_vpT_Ar(vi(3), P, T) * (vi(3) - vi(1)) / (f_vpT_Ar(vi(3), P, T) - f_vpT_Ar(vi(1), P, T))

    'Debug.Print "vi(4)="; vi(4)

    'v = vi(4)

    End If

    Dim i As Integer

    i = 4

   

    'Debug.Print "f(vi(1),p,T)="; f(vi(1), p, T)

    'Debug.Print "f(vi(2),p,T)="; f(vi(2), p, T)

    Do Until Abs(f_vpT_Ar(vi(i), P, T)) < 0.00001

   

        vi(i + 1) = vi(i) - f_vpT_Ar(vi(i), P, T) * (vi(i) - vi(1)) / (f_vpT_Ar(vi(i), P, T) - f_vpT_Ar(vi(1), P, T))

       

        i = i + 1

        'Debug.Print "vi("; i; ")="; vi(i)

        'Debug.Print "f("; i; ","; p; ","; T; ")="; f(vi(i), p, T)

        If i >= 10000 Then

        Exit Function

        End If

       

    Loop

   

    V_PT_Ar = vi(i)

    On Error Resume Next

End Function

'密度，kg/m3

Function rou_PT_Ar(P, T)

    rou_PT_Ar = 1 / V_PT_Ar(P, T)

   

End Function

'2.氩气的比热

Function cp0_T_Ar(T)

    Dim b()

    ReDim Preserve b(0 To 4)

    b(0) = 2.5064281

    b(1) = -0.00000767

    b(2) = 0.00000001234

    b(3) = 0

    b(4) = 0

    cp0_Ar = 0

    For i = 0 To 4

        cp0_Ar = cp0_Ar + b(i) * T ^ (i)

    Next

    cp0_T_Ar = R * cp0_Ar

   

End Function

Function cv0_T_Ar(T)

    cv0_T_Ar = cp0_T_Ar(T) - R

End Function

Function cv_PT_Ar(P, T) 'J/kg.K

    Dim A0, a, B0, b, c

        A0 = 81.033

        a = 0.000583312

        B0 = 0.000984966

        b = 0

        c = 1500.88

        Dim V

        V = V_PT_Ar(P, T)

       

        cv_PT_Ar = cv0_T_Ar(T) + (6 * R * c / ((T ^ 3) * V)) * (1 + B0 / V * (0.5 - b / (3 * V)))

End Function

Function cp_PT_Ar(P, T)

    Dim A0, a, B0, b, c

        A0 = 81.033

        a = 0.000583312

        B0 = 0.000984966

        b = 0

        c = 1500.88

        Dim V

        V = V_PT_Ar(P, T)

    Dim z1, z2, z3, m1, m2, m3, m4, m5

        z1 = V + B0 * (1 - b / V)

        z2 = 1 + 2 * c / (T * T * T * V)

        z3 = R * (z1 * z2) ^ 2

        m1 = (2 * P * V ^ 3) / (R * T)

        m2 = -(c * B0 / T ^ 3) * (1 - 2 * b / V)

        m3 = -V ^ 2 - B0 * b

        m4 = A0 * a / (R * T)

        m5 = m1 + m2 + m3 + m4

    cp_PT_Ar = cv_PT_Ar(P, T) + z3 / m5

End Function

'3 氩气焓值计算

Function H_PT_Ar(P, T) 'k/kg

      Dim A0, a, B0, bb, c

        A0 = 81.033

        a = 0.000583312

        B0 = 0.000984966

        bb = 0

        c = 1500.88

        Dim V

        V = V_PT_Ar(P, T)

        'Debug.Print "v="; v

        Dim b()

        ReDim Preserve b(0 To 4)

        b(0) = 2.5064281

        b(1) = -0.00000767

        b(2) = 0.00000001234

        b(3) = 0

        b(4) = 0

       

    Dim f1, f2, f3, f4, f5, f6

        f1 = 0

        For n = 0 To 4

            f1 = f1 + (b(n) * T ^ n) / (n + 1)

        Next

        

        f1 = R * T * (f1 - 1)

       

        f2 = (A0 / V) * (a / (2 * V) - 1)

        f3 = -3 * R * c / (T * T * c)

        f4 = 1 + (B0 / V) * (0.5 - bb / (3 * V))

        f5 = P * V + h0

        f6 = f1 + f2 + f3 * f4 + f5

        H_PT_Ar = f6

End Function

'熵计算

Function S_PT_Ar(P, T)

    's = cp0 * Log(T / T0) - R * Log(p / p0) - BP(T) * p + s0

   

     Dim A0, a, B0, bb, c

        A0 = 81.033

        a = 0.000583312

        B0 = 0.000984966

        bb = 0

        c = 1500.88

        Dim V

        V = V_PT_Ar(P, T)

        'Debug.Print "v="; v

        Dim b()

        ReDim Preserve b(0 To 4)

        b(0) = 2.5064281

        b(1) = -0.00000767

        b(2) = 0.00000001234

        b(3) = 0

        b(4) = 0

       

    Dim f1, f2, f3, f4, f5, f6, f7, f8

        f1 = 0

        For n = 1 To 4

            f1 = f1 + (b(n) * T ^ n) / n

        Next

       

        f1 = R * ((b(0) - 1) * Log(T) + f1)

       

        f2 = Log(Abs(V))

        f3 = 1 - bb / (2 * V)

        f4 = 2 / B0 + 1 / V - 2 * bb / (3 * V * V)

        f5 = c * f4 / T ^ 3

        f6 = -(f5 + f3) * B0 / V

        f7 = R * (f2 + f6)

        f8 = f1 + f7 + s0

        S_PT_Ar = f8

End Function

'粘度

'压力在100000-140*100000Pa范围内，粘度只是温度的函数'kg/m.s

Function yita_PT_Ar(P, T)

    Dim D(5)

    D(1) = 0.000001414

    D(2) = 116.4

    D(3) = 0.00115

    D(4) = 1

    D(5) = 1.64

    Dim yita1

    yita1 = (D(1) * T ^ 0.546) / (1 + D(2) / T)

    Dim P1, T1

    P1 = 101352.5

    T1 = 273.15

   

    yita_PT_Ar = yita1 * (1 + D(3) * ((P / P1 - 1) ^ D(4)) * (T1 / T) ^ D(5))

   

End Function

'导热系数'W/m.K

Function lamda_PT_Ar(P, T)

     'Dim a()

     'ReDim Preserve a(0 To 4)

        'a(0) = 0.001310641

        'a(1) = 0.000092366747

        'a(2) = -0.000000034716902

        'a(3) = -5.089499E-12

        'a(4) = 1.0818806E-14

    Dim lamda0, T0

       

        T0 = 273.15

        lamda0 = 0.01636 * (T / T0) ^ 0.77

    'Dim n As Integer

    'For n = 0 To 4

        'lamda0 = lamda0 + a(n) * T ^ n

    'Next

   

    Dim rr

    rr = rou_PT_Ar(P, T)

    lamda_PT_Ar = lamda0 + 0.00000946 * rr ^ 1.17

   

End Function

'普朗特数

Function Pr_PT_Ar(P, T)

    Dim cp, yita, lamda

    cp = cp_PT_Ar(P, T)

    yita = yita_PT_Ar(P, T)

    lamda = lamda_PT_Ar(P, T)

    Pr_PT_Ar = cp * yita / lamda

End Function

'声速 m/s

Function Vs_PT_Ar(P, T)

    '等熵指数K计算

   

    Dim k, cp, cv, V

    Dim A0, a, B0, b, c

        A0 = 81.033

        a = 0.000583312

        B0 = 0.000984966

        b = 0

        c = 1500.88

        cp = cp_PT_Ar(P, T)

        cv = cv_PT_Ar(P, T)

        V = V_PT_Ar(P, T)

       

    Dim f1, f2, f3, f4, f5, f6, f7

        f1 = cp / cv

        f2 = R * T / (P * V)

        f3 = c * B0 / (T * T * T * V * V)

        f4 = 1 - 2 * b / V

        f5 = 1 + B0 * b / (V * V)

        f6 = A0 * a / (V * V * 296.78 * T)

        f7 = f1 * (2 - f2 * (f3 * f4 + f5 - f6))

        k = f7

   

    Vs_PT_Ar = (k * P * V) ^ 0.5

End Function

'压缩因子

Function Z_PT_Ar(P, T)

    Z_PT_Ar = P * V_PT_Ar(P, T) / (R * T)

End Function

'反算，根据压力，熵反算焓

Function f_pTs_Ar(P, T, S)

    f_pTs_Ar = S_PT_Ar(P, T) - S

End Function

Function H_PS_Ar(pp, ss) '根据压力和熵求焓

   Dim Ti(10000), f1, f2, f3

    Ti(1) = 100

    Ti(2) = 1300

    Do Until Abs(Ti(2) - Ti(1)) < 0.00001

            Ti(3) = (Ti(1) + Ti(2)) / 2

            f1 = f_pTs_Ar(pp, Ti(1), ss)

            f2 = f_pTs_Ar(pp, Ti(2), ss)

            f3 = f_pTs_Ar(pp, Ti(3), ss)

        If f1 * f3 < 0 Then

            Ti(2) = Ti(3)

        Else

            Ti(1) = Ti(3)

        End If

    Loop

        H_PS_Ar = H_PT_Ar(pp, Ti(3))

       

End Function

Function f_pTh_Ar(P, T, H)

    f_pTh_Ar = H_PT_Ar(P, T) - H

End Function

Function S_PH_Ar(pp, hh) '根据压力和焓求熵

   Dim Ti(10000), f1, f2, f3

    Ti(1) = 100

    Ti(2) = 1300

    Do Until Abs(Ti(2) - Ti(1)) < 0.00001

            Ti(3) = (Ti(1) + Ti(2)) / 2

            f1 = f_pTh_Ar(pp, Ti(1), hh)

            f2 = f_pTh_Ar(pp, Ti(2), hh)

            f3 = f_pTh_Ar(pp, Ti(3), hh)

        If f1 * f3 < 0 Then

            Ti(2) = Ti(3)

        Else

            Ti(1) = Ti(3)

        End If

    Loop

        S_PH_Ar = S_PT_Ar(pp, Ti(3))

End Function

Function T_PH_Ar(pp, hh)

    Dim Ti(10000), f1, f2, f3

    Ti(1) = 100

    Ti(2) = 1300

    Do Until Abs(Ti(2) - Ti(1)) < 0.00001

            Ti(3) = (Ti(1) + Ti(2)) / 2

            f1 = f_pTh_Ar(pp, Ti(1), hh)

            f2 = f_pTh_Ar(pp, Ti(2), hh)

            f3 = f_pTh_Ar(pp, Ti(3), hh)

        If f1 * f3 < 0 Then

            Ti(2) = Ti(3)

        Else

            Ti(1) = Ti(3)

        End If

    Loop

        T_PH_Ar = Ti(3)

End Function

Function T_PS_Ar(pp, ss)

    Dim Ti(10000), f1, f2, f3

    Ti(1) = 99

    Ti(2) = 1300

    Do Until Abs(Ti(2) - Ti(1)) < 0.0000001

            Ti(3) = (Ti(1) + Ti(2)) / 2

            f1 = f_pTs_Ar(pp, Ti(1), ss)

            f2 = f_pTs_Ar(pp, Ti(2), ss)

            f3 = f_pTs_Ar(pp, Ti(3), ss)

            'Debug.Print "f1="; f1

            'Debug.Print "f2="; f2

            'Debug.Print "f3="; f3

        If f1 * f3 < 0 Then

            Ti(2) = Ti(3)

        Else

            Ti(1) = Ti(3)

        End If

    Loop

        T_PS_Ar = Ti(3)

End Function

'这个计算有点问题

Function P_TH_Ar(T, H)

    Dim pi1, pi2, pi3, f1, f2, f3

    pi1 = 99999

    pi2 = 9999999

    Do Until Abs(pi2 - pi1) < 0.0000001

            pi3 = (pi1 + pi2) / 2

            f1 = f_pTh_Ar(pi1, T, H)

            f2 = f_pTh_Ar(pi2, T, H)

            f3 = f_pTh_Ar(pi3, T, H)

        If f1 * f3 < 0 Then

            pi2 = pi3

        Else

            pi1 = pi3

        End If

    Loop

        P_TH_Ar = pi3

End Function

Private Sub CommandButton1_Click()

    Debug.Print "="; P_TH_Ar(1273.15, 664900)

   

End Sub