| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 3265 人关注过本帖
标题:Public Const num As Integer = 200这句有什么问题吗?
只看楼主 加入收藏
keke0101
Rank: 1
等 级:新手上路
帖 子:1
专家分:0
注 册:2016-4-20
结帖率:0
收藏
已结贴  问题点数:20 回复次数:2 
Public Const num As Integer = 200这句有什么问题吗?
求大神告知程序有什么问题?怎么修改!程序是关于分布式电源优化配置的粒子群算法
全局变量   
Public Const num  As Integer = 200
Public Const t  As Integer = 100
Public h, y As Integer
Public l1(), n1(), m1(32, 32), e(32), f(32) As Integer
Public l3(32, 2), n3(33, 2), n4(33, 2), s1(32, 2), u1(33, 4), uo(33, 4), pi(33), qi(33) As Single
Public a(33, 32), a1(33, 32) As Integer
Public l(), n() As Integer
Public pe(33), qe(33), pe1(33), pe2(33), b(33, 33), g(33, 33), p3(32), p5, p6, p7 As Single
Public x1(num, 10), i3 As Integer
Public uu(33, 4), pdg As Single
Public frag As Integer
Public cl, cen, cg, cl1, cen1
   
窗体代码
   
Option Base 1
Dim cl, cen As Single

Private Sub Command1_Click()
Randomize
m = 2
Dim c1, c2, d1, d2, ws, we, w, fc(num), pbest(num), clb(num), cenb(num), gbest, gclb, gcenb As Single
Dim xdown, xup As Single
Dim v(num, 10), vmax, vmin As Single
Dim pbestx(num, 10) As Single
Dim gbestx(10) As Single
c1 = 2.8
c2 = 1.3
wmax = 0.95
wmin = 0.4
xdown = 0
xup = 0.4
vmax = (xup - xdown) * 0.3
vmin = -(xup - xdown) * 0.3

For i3 = 1 To num
    Randomize
    Do
      pdg = 0
      For i1 = 1 To 10
          x1(i3, i1) = xdown + (xup - xdown) * Rnd
          If x1(i3, i1) < 0.05 Then
             x1(i3, i1) = 0
          End If
          pdg = pdg + x1(i3, i1) * 1000
          v(i3, i1) = vmax * (2 * Rnd - 1)
       Next i1
    Loop While pdg > 1016
    pbest(i3) = func
    clb(i3) = cl
    cenb(i3) = cen
   
    For i1 = 1 To 10
        pbestx(i3, i1) = x1(i3, i1)
    Next i1
Next i3


gbest = pbest(1)
gclb = clb(1)
gcenb = cenb(1)
For i1 = 1 To 10
    gbestx(i1) = x1(1, i1)
Next i1


For i = 1 To num
   If pbest(i) < gbest Then
      gbest = pbest(i)
      gclb = clb(i)
      gcenb = cenb(i)
      For i1 = 1 To 10
         gbestx(i1) = x1(i, i1)
      Next i1
   End If
Next i


For i = 1 To 33
   For j = 1 To 4
   uu(i, j) = u1(i, j)
   Next j
Next i


Do While m <= t
   w = (wmin - wmax) * (t - m) / t + wmax
        For i3 = 1 To num
            Randomize
            pdg = 0

         For i1 = 1 To 10
              v(i3, i1) = w * v(i3, i1) + c1 * Rnd * (pbestx(i3, i1) - x1(i3, i1)) + c2 * Rnd * (gbestx(i1) - x1(i3, i1))
              If v(i3, i1) > vmax Then
               v(i3, i1) = vmax
              End If
              If v(i3, i1) < vmin Then
                 v(i3, i1) = vmin
              End If

              x1(i3, i1) = x1(i3, i1) + v(i3, i1)
   
              If x1(i3, i1) < 0.05 Then
                 x1(i3, i1) = 0
              End If
              If x1(i3, i1) > xup Then
                 x1(i3, i1) = xup
              End If
              pdg = pdg + x1(i3, i1) * 1000
         Next i1
        
            fc(i3) = func
            If pbest(i3) > fc(i3) Then
               pbest(i3) = fc(i3)
               clb(i3) = cl
               cenb(i3) = cen
               For i1 = 1 To 10
                   pbestx(i3, i1) = x1(i3, i1)
               Next i1
            End If
   
              If pbest(i3) < gbest Then
              gbest = pbest(i3)
              gclb = clb(i3)
              gcenb = cenb(i3)
              p7 = p5
              For i1 = 1 To 10
                  gbestx(i1) = pbestx(i3, i1)
              Next i1
              
               For i = 1 To 33
               For j = 1 To 4
                 uu(i, j) = u1(i, j)
               Next j
               Next i

            End If

       Next i3
      
       m = m + 1
Loop


Timer1.Enabled = False
For i = 1 To 33
       Shape1(i - 1).FillColor = &HFFFFFF
Next i


For i = 1 To 10
   If gbestx(i) <> 0 Then
      Shape1(pe1(i) - 1).FillColor = &H0&
      Label5(i - 1).Caption = gbestx(i) * 1000
   End If
Next i


Form3.Label4.Caption = Format(cl1, "###.00") & "   万元"
Form3.Label5.Caption = Format(cen1, "###.00") & "  万元"
Form3.Label6.Caption = Format(cg, "###.00") & "  万元"
Form3.Label7.Caption = Format(gclb, "###.00") & "   万元"
Form3.Label8.Caption = Format(gcenb, "###.00") & "  万元"
Form3.Label9.Caption = Format(gbest, "###.00") & "  万元"

Load Form3
Form3.Print
Form3.Print
Form3.Print
Form3.Print Spc(26); "无 D G 时"; Spc(15); "有 D G 时"
Form3.Print
Form3.Show
Form3.Print Spc(12); "节点"; Spc(5); "电压幅值"; Spc(4); "电压相角"; Spc(4); "电压幅值"; Spc(4); "电压相角"
For i = 1 To 33

   Form3.Print Spc(13); Format(i, "00"); Spc(6);
  For j = 3 To 4
  
  Form3.Print Format(uo(i, j), "0.00000"); Spc(5);
  
  Next j
  For j = 3 To 4
  
  Form3.Print Format(uu(i, j), "0.00000"); Spc(5);
  Next j
  Form3.Print

Next i


End Sub


Private Function func() As Single

For i = 1 To 33
 For j = 1 To 2
  n4(i, j) = n3(i, j)
 Next j
Next i

For i1 = 1 To 10
    n4(pe1(i1), 1) = n3(pe1(i1), 1) - x1(i3, i1) * 1000 / 10000
    n4(pe1(i1), 2) = n3(pe1(i1), 2) - (x1(i3, i1) * 1000 * Sqr(1 - 0.9 ^ 2) / 0.9) / 10000
Next i1


Call caoliu

cl = 0.5 * 3000 * p5
pdgsum = 0
For i = 1 To 10
pdgsum = pdgsum + x1(i3, i) * 1000
Next i

cen = (5084.26 - pdgsum - (p6 * 10000 - p7 * 10000)) * 3000 * 0.5 / 10000

ku = 0
For i = 1 To 33
 If u1(i, 3) < 0.9 Then
    ku = ku + 10 * (0.9 - u1(i, 3)) ^ 2
 Else
    If u1(i, 3) > 1.1 Then
       ku = ku + 10 * (u1(i, 3) - 1.1) ^ 2
    Else
       ku = 0
    End If
 End If
Next i


 If pdg > 1016 Then
    kdg = 10 * (pdg - 1016)
 Else
    kdg = 0
 End If

 
zcost = cl + cen + ku + kdg
func = zcost



End Function


Private Sub Command2_Click()

Dim appexcel As Object '定义Excel应用程序对象
Dim wbmybook As Object '定义工作簿对象
Dim wsmysheet As Object  '定义工作表对象
'Private Sub Command1_Click() '打开EXCEL过程
   Set appexcel = CreateObject("excel.application") '创建Excel应用程序对象
   Set wbmybook = appexcel.Workbooks.Open("c:\data.xls") '打开EXCEL工作簿.
   Set wsmysheet = wbmybook.Worksheets(1) '打开EXCEL工作表
   wsmysheet.Activate '激活工作表
   
   
   appexcel.Visible = True '应用程序Excel可见
   'wbmybook.Close '关闭工作簿
   'appexcel.Quit '关闭EXCEL
   Set wbmybook = Nothing
   Set wsmysheet = Nothing
   Set appexcel = Nothing


End Sub

Private Sub Form_Load()
Show

For i = 1 To 33

       Shape1(i - 1).FillColor = &HFFFFFF

Next i

For i = 1 To 33  '节点电压初始化
 u1(i, 1) = 1
 u1(i, 3) = 1
 u1(i, 4) = 0
Next i

Call n3l3

i = 1
j = 1

Open "c:\d.txt" For Input As #1 '读入节点支路矩阵
Do While Not EOF(1)
   Input #1, X
   If j <= 32 Then
     a(i, j) = X
     a1(i, j) = X
     j = j + 1
    Else
    j = 1
    i = i + 1
    a(i, j) = X
    a1(i, j) = X
    j = j + 1
    End If
Loop
Close #1

Call juzhen
Call caoliu

For i = 1 To 33
  For j = 1 To 4
  uo(i, j) = u1(i, j)
  Next j
Next i

Timer1.Enabled = True

p6 = p5
Call wangsun


cl1 = 0.5 * 3000 * p6
cen1 = (5804.26 * 3000 * 0.5) / 10000
cg = cl1 + cen1

Load Form2


Form2.Label4.Caption = Format(cl1, "###.00") & "   万元"
Form2.Label5.Caption = Format(cen1, "###.00") & "  万元"
Form2.Label6.Caption = Format(cg, "###.00") & "  万元"


Form2.Print
Form2.Print
Form2.Print
Form2.Print Spc(12); "节点"; Spc(5); "电压幅值"; Spc(4); "电压相角"
For i = 1 To 33

   Form2.Print Spc(13); Format(i, "00"); Spc(6);
  For j = 3 To 4
  
  Form2.Print Format(uo(i, j), "0.00000"); Spc(5);
  Next j
  Form2.Print

Next i
Form2.Show
End Sub


Private Sub caoliu()
Dim umax As Single


Do
umax = 0
p5 = 0
For i = h To 1 Step -1
   For j = 1 To y
   If l1(i, j) <> 0 Then
    p2 = n4(e(l1(i, j)), 1)
    q2 = n4(e(l1(i, j)), 2)
    For i1 = 1 To 32
       If m1(i1, l1(i, j)) = 1 Then
        p2 = p2 + s1(i1, 1)
        q2 = q2 + s1(i1, 2)
       End If
    Next i1
    pi(e(l1(i, j))) = p2
    qi(e(l1(i, j))) = q2
    p3(l1(i, j)) = (p2 ^ 2 + q2 ^ 2) * l3(l1(i, j), 1) / u1(f(l1(i, j)), 3) ^ 2
    p5 = p5 + p3(l1(i, j))
   
   
   p1 = p2 + (p2 ^ 2 + q2 ^ 2) * l3(l1(i, j), 1) / u1(f(l1(i, j)), 3) ^ 2
   q1 = q2 + (p2 ^ 2 + q2 ^ 2) * l3(l1(i, j), 2) / u1(f(l1(i, j)), 3) ^ 2
   s1(l1(i, j), 1) = p1
   s1(l1(i, j), 2) = q1
   End If
   Next j
Next i


For i = 1 To h
   For j = 1 To y
   If n1(i, j) <> 0 Then
    For i1 = 1 To 32
      If e(i1) = n1(i, j) Then
      Exit For
      End If
    Next i1
   e1 = u1(f(i1), 1)
   f1 = u1(f(i1), 2)
   r1 = l3(i1, 1)
   x11 = l3(i1, 2)
   p1 = s1(i1, 1)
   q1 = s1(i1, 2)
   e2 = e1 - ((p1 * r1 + q1 * x11) * e1 - (p1 * x11 - q1 * r1) * f1) / (e1 ^ 2 + f1 ^ 2)
   f2 = f1 - ((p1 * r1 + q1 * x11) * f1 + (p1 * x11 - q1 * r1) * e1) / (e1 ^ 2 + f1 ^ 2)
   u2 = Sqr(e2 ^ 2 + f2 ^ 2)
   
   umax1 = Abs(u2 - u1(n1(i, j), 3))
   If umax1 > umax Then
    umax = umax1
   End If
   u1(n1(i, j), 1) = e2
   u1(n1(i, j), 2) = f2
   u1(n1(i, j), 3) = u2
   u1(n1(i, j), 4) = Atn(f2 / e2)
  End If
  Next j
Next i

Loop While umax >= 0.000001

End Sub

Private Sub n3l3()        '读入节点负荷和支路参数给l3,n3

Dim appexcel As Object '定义Excel应用程序对象
Dim wbmybook As Object '定义工作簿对象
Dim wsmysheet As Object  '定义工作表对象
'Private Sub Command1_Click() '打开EXCEL过程
   Set appexcel = CreateObject("excel.application") '创建Excel应用程序对象
   Set wbmybook = appexcel.Workbooks.Open("c:\n3.xls") '打开EXCEL工作簿.
   Set wsmysheet = wbmybook.Worksheets(1) '打开EXCEL工作表
   wsmysheet.Activate '激活工作表
   
   For i = 1 To 33
    For j = 1 To 2
    n3(i, j) = wsmysheet.Cells(i, j)
    n3(i, j) = n3(i, j) / 10000
    n4(i, j) = n3(i, j)
    Next j
   Next i
   
   appexcel.Visible = False '应用程序Excel不可见
   wbmybook.Close '关闭工作簿
   appexcel.Quit '关闭EXCEL
   Set wbmybook = Nothing
   Set wsmysheet = Nothing
   Set appexcel = Nothing
      
   Set appexcel = CreateObject("excel.application") '创建Excel应用程序对象
   Set wbmybook = appexcel.Workbooks.Open("c:\l3.xls") '打开EXCEL工作簿.
   Set wsmysheet = wbmybook.Worksheets(1) '打开EXCEL工作表
   wsmysheet.Activate '激活工作表
   
   For i = 1 To 32
    For j = 1 To 2
    l3(i, j) = wsmysheet.Cells(i, j)
    l3(i, j) = l3(i, j) / 16
    Next j
   Next i
   
   appexcel.Visible = False '应用程序Excel不可见
   wbmybook.Close '关闭工作簿
   appexcel.Quit '关闭EXCEL
   Set wbmybook = Nothing
   Set wsmysheet = Nothing
   Set appexcel = Nothing

End Sub

Private Sub juzhen() '形成相关矩阵

m = 0
X = 2
y = 0
w = 0
v = 1
Z = 0
ReDim Preserve n(X - v)
n(X - v) = 1


Do While Z <> 32  '形成用于生成节点支路层次矩阵的矩阵

  For i = v To 1 Step -1
    For j = 1 To 32
      If a(n(X - i), j) = 1 Then
         w = w + 1
         m = m + 1
         ReDim Preserve l(m)
         l(m) = j
         f(j) = n(X - i)
       ' Print f(j)
         a(n(X - i), j) = 0
      End If
    Next j
  Next i
  m = m + 1
  ReDim Preserve l(m)
  l(m) = 0
  v = 0
  
  For j = w To 1 Step -1
    For i = 1 To 33
      If a(i, l(m - j)) = 1 Then
         v = v + 1
         X = X + 1
         ReDim Preserve n(X)
         n(X) = i
         e(l(m - j)) = i
       ' Print e(l(m - j))
         a(i, l(m - j)) = 0
         Z = Z + 1
      End If
    Next i
  Next j
  
  If v > y Then
     y = v
  End If
  
  X = X + 1
  ReDim Preserve n(X)
  n(X) = 0
  w = 0
  
Loop



For i1 = 1 To 33       '形成节点阻抗矩阵
  For j1 = 1 To 33
    If i1 = j1 Then
      For j = 1 To 32
        If a1(i1, j) = 1 Then
           b(i1, i1) = b(i1, i1) + l3(j, 2)
           g(i1, i1) = g(i1, i1) + l3(j, 1)
        End If
      Next j
    Else
      For i2 = 1 To 32
        If (f(i2) = i1 And e(i2) = j1) Or (f(i2) = j1 And e(i2) = i1) Then
           b(i1, j1) = l3(i2, 2)
           g(i1, j1) = l3(i2, 1)
           Exit For
        End If
      Next i2
    End If
  Next j1
Next i1
  

h = 0
For i = 1 To m
  If l(i) = 0 Then
     h = h + 1
  End If
Next i
ReDim l1(h, y)
ReDim n1(h, y)
'ReDim l2(h, y)
'ReDim n2(h, y)
i = 1
p = 1

For j = 1 To m             '形成支路层次矩阵
  If l(j) <> 0 Then
     l1(i, p) = l(j)
     p = p + 1
  Else
     i = i + 1
     p = 1
  End If
Next j

i = 1
p = 1
For j = 3 To X           '形成节点层次矩阵
  If n(j) <> 0 Then
     n1(i, p) = n(j)
   ' Print n1(i, h)
     p = p + 1
  Else
     i = i + 1
     p = 1
  End If
Next j

For i = 1 To 32        '形成支路关联矩阵
  For j = 1 To 32
   If e(j) = f(i) Then
      m1(i, j) = 1
   End If
  Next j
Next i


End Sub

Private Sub wangsun()

For i = 1 To 33
    x7 = -(1 / (qi(i) + u1(i, 3) ^ 2 * b(i, i)))
    x4 = 0
    x22 = (pi(i) ^ 2 + qi(i) ^ 2) * x4
  For j = 1 To 33
     x5 = -g(i, j) * Sin(u1(i, 4) - u1(j, 4)) * x7 / (u1(i, 3) * u1(j, 3))
     x6 = g(i, j) * Cos(u1(i, 4) - u1(j, 4)) * x7 / (u1(i, 3) * u1(j, 3))
     x9 = g(i, j) * Cos(u1(i, 4) - u1(j, 4)) / (u1(i, 3) * u1(j, 3))
     x10 = g(i, j) * Sin(u1(i, 4) - u1(j, 4)) / (u1(i, 3) * u1(j, 3))
     If i <> j Then
      x11 = x11 + x9 * pi(j) - x10 * qi(j)
      x33 = x33 + ((pi(i) * pi(j) + qi(i) * qi(j)) * x5 - (pi(i) * qi(j) - qi(i) * pi(j)) * x6)
      Else
      x11 = x11 + x9 * pi(j) - x10 * qi(j)
     End If
   Next j
   
   pe(i) = 2 * x11 + x22 + 2 * x33
   x11 = 0
   x33 = 0
Next i
   
     
 For i = 1 To 33
    pmax = pe(1)
    For j = 1 To 33
     If pe(j) > pmax Then
        pmax = pe(j)
        pe1(i) = j
        pe2(i) = pe(j)
     End If
    Next j
    pe(pe1(i)) = 0
 Next i
   
For i = 1 To 33
 Print pe1(i); pe2(i)
Next i

End Sub

Private Sub Timer1_Timer()
If frag = 1 Then
   For i = 1 To 33
    If u1(i, 3) < 0.9 Or u1(i, 3) > 1.1 Then
       Shape1(i - 1).FillColor = &HFF&
    End If
   Next i
   frag = 0
Else
   For i = 1 To 33
    If u1(i, 3) < 0.9 Or u1(i, 3) > 1.1 Then
       Shape1(i - 1).FillColor = &HFFFFFF
    End If
   Next i
   frag = 1
End If
   
End Sub





[此贴子已经被作者于2016-4-20 20:49编辑过]

搜索更多相关主题的帖子: 电源 电源 
2016-04-20 20:36
yuk_yu
Rank: 3Rank: 3
等 级:论坛游侠
帖 子:334
专家分:134
注 册:2009-3-16
收藏
得分:10 
VB6中似乎不能这么定义,才可以
2016-04-21 08:49
wating
Rank: 2
等 级:论坛游民
帖 子:48
专家分:18
注 册:2016-2-23
收藏
得分:10 
回复 楼主 keke0101
  常数赋值。num=200
2016-04-21 09:03
快速回复:Public Const num As Integer = 200这句有什么问题吗?
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.029620 second(s), 8 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved