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编辑过]
