猛犸论坛【以梦为马,不负韶华】

搜索
搜索附件  
猛犸论坛【以梦为马,不负韶华】 下载中心 〖化工机械与设备交流〗 〖塔器设计制造及应用〗 用excel的宏求解精馏塔塔板数的编码出现错误,求大神指导.rar

用excel的宏求解精馏塔塔板数的编码出现错误,求大神指导.rar

 

用excel的宏求解精馏塔塔板数,编码错误。求大神指导,我把编好的编码一起打包了。:
用excel的宏求解精馏塔塔板数,编码错误。求大神指导,我把编好的编码一起打包了。
Sub hong()
Dim xcz(100) As Variant
Dim ycz(100) As Variant
Dim xph(100) As Variant
Dim yph(100) As Variant
Dim u(100) As Variant
Dim v(100) As Variant
Dim i As Integer
Dim nph As Single
Dim xa As Single
Dim ya As Single
Dim xb As Single
Dim yb As Single
Dim q As Single
Dim R As Integer
Dim xf As Single
Dim xd As Single
For i = 1 To 100
u(i) = ActiveSheet.Cells(i, 6)
v(i) = ActiveSheet.Cells(i, 5)
If u(1) = 1 And u(i) = 0 Then nph = i
If u(1) = 0 And u(i) = 1 Then nph = i
Next i
xa = "ActiveSheet.Cells(1,15)"
ya = "ActiveSheet.Cells(1,15)"
xb = "ActiveSheet.Cells(2,15)"
yb = "ActiveSheet.Cells(2,15)"
q = "ActiveSheet.Cells(3,15)"
R = ActiveSheet.Cells(4, 15)
xf = "ActiveSheet.Cells (5,15)"
xd = ((xa / (R + 1) + (xf / (q - 1 + 0.0000000001))) / (q / (q - 1 + le - 10)) - (R / (R + 1)))
yd = q / (q - 1 + 0.0000000001) * ((xa / (R + 1) + (xf / (q - 1 + le - 10))) / (q / (q - 1 + 0.0000000001))) - (R / (R + 1)) - xf / (q - 1 + 0.0000000001)
ActiveSheet.Cells(6, 15) = xd
ActiveSheet.Cells(6, 16) = yd
xc = xa
yc = ya
For i = 1 To 100
xcz(i) = xc
ycz(i) = yc
xc = chazhi(u, v, yc, npl)
xph(i) = xc
yph(i) = yc
ActiveSheet.Cells(i, 1) = xph(i)
ActiveSheet.Cells(i, 2) = yph(i)
xcz(i) = "ActiveSheet.Cells(i*2-1,11)"
    ycz(i) = "ActiveSheet.Cells(i*2-1,12)"
    ActiveSheet.Cells(2 * i, 11) = xph(i)
    ActiveSheet.Cells(2 * i, 12) = yph(i)
    If xc < xd Then
    xab = xb
    yab = yb
    Else
    xab = xa
    yab = ya
    End If
    yc = (yab - yd) / (xab - xd) * (xc - yd)
    If xph(i - 1) > xd And xph(i) < xd Then GoTo ActiveSheet
        Cells(5, 8) = i - 1 + (xph(i - 1) - xd) / (xph(i - 1)) = xph(i)
End If
    ActiveSheet.Cells(4, 8) = i - 1 + (xph(i - 1) - xb) / (xph(i - 1) - xph(i))
     If xc < xb Then
     End If
     Next i
     End Sub
Function chazhi(x, y, u, nph)
n = nph
For k = 1 To n - 1
  If (u - x(l) * (u - x(n))) <= 0 Then GoTo 10
  End If
Next k
If (u - x(l) * (u - x(n))) <= 0 Then k = 1 Else k = n - 1
10 G = (u - x(k) * (u - x(k + 1)))
End If
If k = n - 1 Or k <> 1 And G Then k = k - 1
v = 0
For i = k To k + 2
l = 1
For j = k To k + 2
If i <> j Then l = l * (u - x(j)) / (x(i) - x(j))
Next j
v = v + l * y(i)
Next i
chazhi = v
End Function

刚刚我在调试了下,好像还有点问题。我不会
改了一下,你看看

Sub hong()
        Dim xcz(100) As Variant
        Dim ycz(100) As Variant
        Dim xph(100) As Variant
        Dim yph(100) As Variant
        Dim u(100) As Variant
        Dim v(100) As Variant
        Dim i As Integer
        Dim nph As Single
        Dim xa As Single
        Dim ya As Single
        Dim xb As Single
        Dim yb As Single
        Dim q As Single
        Dim R As Integer
        Dim xf As Single
        Dim xd As Single
        For i = 1 To 100
                u(i) = ActiveSheet.Cells(i, 6)
                v(i) = ActiveSheet.Cells(i, 5)
                If u(1) = 1 And u(i) = 0 Then nph = i
                If u(1) = 0 And u(i) = 1 Then nph = i
        Next i
        xa = ActiveSheet.Cells(1,15)
        ya = ActiveSheet.Cells(1,15)
        xb = ActiveSheet.Cells(2,15)
        yb = ActiveSheet.Cells(2,15)
        q = ActiveSheet.Cells(3,15)
        R = ActiveSheet.Cells(4, 15)
        xf = ActiveSheet.Cells (5,15)
        xd = ((xa / (R + 1) + (xf / (q - 1 + 0.0000000001))) / (q / (q - 1 + le - 10)) - (R / (R + 1)))
        yd = q / (q - 1 + 0.0000000001) * ((xa / (R + 1) + (xf / (q - 1 + le - 10))) / (q / (q - 1 + 0.0000000001))) - (R / (R + 1)) - xf / (q - 1 + 0.0000000001)
        ActiveSheet.Cells(6, 15) = xd
        ActiveSheet.Cells(6, 16) = yd
        xc = xa
        yc = ya
        For i = 1 To 100
                xcz(i) = xc
                ycz(i) = yc
                xc = chazhi(u, v, yc, npl)
                xph(i) = xc
                yph(i) = yc
                ActiveSheet.Cells(i, 1) = xph(i)
                ActiveSheet.Cells(i, 2) = yph(i)
                xcz(i) = ActiveSheet.Cells(i*2-1,11)
                ycz(i) = ActiveSheet.Cells(i*2-1,12)
                ActiveSheet.Cells(2 * i, 11) = xph(i)
                ActiveSheet.Cells(2 * i, 12) = yph(i)
                If xc < xd Then
                        xab = xb
                        yab = yb
                Else
                        xab = xa
                        yab = ya
                End If
                yc = (yab - yd) / (xab - xd) * (xc - yd)
                If xph(i - 1) > xd And xph(i) < xd Then GoTo ActiveSheet
                        Cells(5, 8) = i - 1 + (xph(i - 1) - xd) / (xph(i - 1)) = xph(i)
                End If
                ActiveSheet.Cells(4, 8) = i - 1 + (xph(i - 1) - xb) / (xph(i - 1) - xph(i))
                If xc < xb Then
                End If
        Next i
End Sub

Function chazhi(x, y, u, nph)
        n = nph
        For k = 1 To n - 1
          If (u - x(l) * (u - x(n))) <= 0 Then GoTo 10
          End If
        Next k
        If (u - x(l) * (u - x(n))) <= 0 Then k = 1 Else k = n - 1
        10:
        G = (u - x(k) * (u - x(k + 1)))
        End If
        If k = n - 1 Or k <> 1 And G Then k = k - 1
        v = 0
        For i = k To k + 2
                l = 1
                For j = k To k + 2
                        If i <> j Then l = l * (u - x(j)) / (x(i) - x(j))
                Next j
                v = v + l * y(i)
        Next i
        chazhi = v
End Function
ps122 发表于 2016-3-21 10:36
改了一下,你看看

Sub hong()

谢谢您!好像还有一点点小问题,我运行的时候它显示未定义标签是啥意思。下面这句Activesheet
If xph(i - 1) > xd And xph(i) < xd Then GoTo ActiveSheet
小招忒 发表于 2016-3-21 16:20
谢谢您!好像还有一点点小问题,我运行的时候它显示未定义标签是啥意思。下面这句Activesheet
If xph(i  ...

改成这样
If xph(i - 1) > xd And xph(i) < xd Then
        ActiveSheet.Cells(5, 8) = i - 1 + (xph(i - 1) - xd) / (xph(i - 1)) = xph(i)
End If

这个帖子不回对不起自己!我想我是一天也不能离开马后炮化工

手机版|猛犸论坛【以梦为马,不负韶华】

GMT+8, 2025-7-9 13:40

Powered by 猛犸论坛【以梦为马,不负韶华】

© 2024-2099 Meng.Horse

返回顶部