用excel的宏求解精馏塔塔板数，编码错误。求大神指导，我把编好的编码一起打包了。

小招忒

用excel的宏求解精馏塔塔板数，编码错误。求大神指导，我把编好的编码一起打包了。

ps122

excel文件里为空，确定有代码？

小招忒

ps122 发表于 2016-3-20 19:00

                               
登录/注册后可看大图

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
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 +1e-10)))/((q/(q-1+le-10)Ò»(R/ (R+1))
yd=q/(q-1 +1e-10)*((xa/(R+1)+(xf/(q-1+le-10)))/((q/(q-1+1e-10)
-(R/(R+1))Ò»xf / (q-1+1 e-10)
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)
ActiveSheet.Cells(i*2-1£¬11)=xcz(i)
    ActiveSheet.Cells(i*2-1£¬12)=ycz(i)
    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

改了一下，你看看

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

ps122

小招忒 发表于 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

BMHG001

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