小招忒 发表于 2016-3-20 13:15:36

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

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

ps122 发表于 2016-3-20 13:15:36

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

小招忒 发表于 2016-3-20 13:15:36

ps122 发表于 2016-3-20 19:00 static/image/common/back.gif
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

小招忒 发表于 2016-3-20 13:15:36

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-20 13:15:36

改了一下，你看看

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

小招忒 发表于 2016-3-20 13:15:36

ps122 发表于 2016-3-21 10:36
改了一下，你看看

Sub hong()


谢谢您！好像还有一点点小问题，我运行的时候它显示未定义标签是啥意思。下面这句Activesheet
If xph(i - 1) > xd And xph(i) < xd Then GoTo ActiveSheet

ps122 发表于 2016-3-20 13:15:36

小招忒 发表于 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 发表于 2016-3-20 13:15:36


这个帖子不回对不起自己！我想我是一天也不能离开马后炮化工。
页: [1]
查看完整版本: 用excel的宏求解精馏塔塔板数，编码错误。求大神指导，我把编好的编码一起打包了。