Attribute VB_Name = "Module3"
Option Explicit
Dim ml()
Public mla()
Public va()
Dim mm()
Dim mn()
Dim mo()
Dim mp()
Dim mq()
Dim my()
Dim mz()
Dim mp2()
Dim q As Integer
Sub grafico()
q = Module1.a
Dim i As Integer
Dim j As Integer
ReDim ml(4 + 2 * q, q + 1)
ReDim mla(4 + q, q)
ReDim mm(4 + 2 * q, q + 1)
ReDim mn(4 + q, q)
ReDim mo(4 + q, q)
ReDim mp(5 + q, q)
ReDim mq(5 + q, q)
ReDim my(4 + q, q)
ReDim mz(4 + q, q)
ReDim mp2(5 + q, q)
Dim vv()
ReDim vv(q)
Dim vw()
ReDim vw(q)
ReDim va(q + 1)
For i = 1 To q + 4
For j = 1 To q
ml(1, j) = Module1.md(1, j)
ml(2, j) = Module1.md(2, j)
ml(3, j) = Module1.md(3, j)
ml(i + 3, j) = Module1.md(i + 3, j)
ml(3 + q + 1, j) = j
Next
Next
For i = 1 To q + 4
For j = 1 To q
mla(i, j) = ml(i, j)
Next
Next
'ordenación de los departamentos por tcr mayor a menor
Dim x As Double
Dim V As Integer
For i = 1 To q
x = ml(3, i)
V = i
For j = 1 To q
If x <= ml(3, j) Then
x = ml(3, j)
V = j
End If
Next
'ordenemos todas las filas
For j = 1 To q + 4
mm(j, i) = ml(j, V)
Next
'vv(i) = V
ml(3, V) = -1E+42
Next
'ordenación de las columnas
For i = 1 To q
For j = 1 To q
mn(1, j) = mm(1, j)
mn(2, j) = mm(2, j)
mn(3, j) = mm(3, j)
mn(4 + q, j) = mm(4 + q, j)
mn(3 + i, j) = mm(3 + i, j)
Next
Next
For i = 1 To q + 4
For j = 1 To q
ml(i, j) = mn(i, j)
Next
Next
'colocación
'************************************************************************************
'coloquemos el departamento de mayor TCR, en caso de empate, al de mayor superficie
Form5.Text1(1).Visible = True
'metemos en va el departamento colocado
va(1) = mn(q + 4, 1)
'y lo quitamos de la matriz de departamentos por colocar
For j = 1 To q + 4
mn(j, 1) = -1E+41
Next
'ordenación de menor a mayor del TCR
'ordenación de los departamentos por tcr de menor a mayor
For i = 1 To q
x = mn(3, i)
V = i
For j = 1 To q
If x <= mn(3, j) Then
x = mn(3, j)
V = j
End If
Next
'ordenemos todas las filas
'vw(i) = V
For j = 1 To q + 4
mo(j, i) = mn(j, V)
Next
mn(3, V) = -1E+42
Next
'ordenación de las columnas
For i = 1 To q
For j = 1 To q
mp(1, q + 1 - j) = mo(1, j)
mp(2, q + 1 - j) = mo(2, j)
mp(3, q + 1 - j) = mo(3, j)
mp(q + 4, q + 1 - j) = mo(q + 4, j)
mp(3 + i, q + 1 - j) = mo(3 + i, j)
Next
Next
For i = 1 To q
mp(5 + q, i) = i
Next
For i = 1 To q + 5
For j = 1 To q
mm(i, j) = mp(i, j)
Next
Next
'en segundo lugar colocamos el departamento con mejor coeficiente de relación con el ya
'colocado, en caso de empate al de mayor TCR
'ordenación de los departamentos por afinidad
Dim k As Integer
Dim k1() As Double
ReDim k1(q + 4)
For k = 2 To q
'++++++++++++++++++++++++++++++++++++++++++++++++++
'sumamos columnas de departamentos ya colocados y eliminamos las filas de estos tb
For i = 1 To q + 5
For j = 1 To q
mp(i, j) = mm(i, j)
Next
Next
For j = 1 To q + 5
For i = 1 To k
mp(j, k1(i)) = -1E+41
Next
Next
For i = 2 To q
For j = 1 To q
If va(i) > 0 Then
mp(va(1) + 3, j) = mp(va(1) + 3, j) + mp(va(i) + 3, j)
mp(va(i) + 3, j) = -1E+41
ElseIf va(i) = 0 Then
mp(va(1) + 3, j) = mp(va(1) + 3, j)
End If
Next
Next
'ordenamos por afinidad a los departamentos ya colocados
For i = 1 To q
x = mp(va(1) + 3, i)
V = i
For j = 1 To q
If x <= mp(va(1) + 3, j) Then
x = mp(va(1) + 3, j)
V = j
End If
Next
'ordenemos todas las filas
For j = 1 To q + 5
mp2(j, i) = mp(j, V)
Next
mp(va(1) + 3, V) = -1E+42
Next
'ordenación de las columnas
For i = 1 To q
For j = 1 To q
mq(1, j) = mp2(1, j)
mq(2, j) = mp2(2, j)
mq(3, j) = mp2(3, j)
mq(4 + q, j) = mp2(4 + q, j)
mq(5 + q, j) = mp2(5 + q, j)
mq(3 + i, j) = mp2(3 + i, j)
Next
Next
'obtenemos el sieguiente departamento a ser colocado
va(k) = mq(q + 4, 1)
k1(k) = mq(q + 5, 1)
'presentación de las iteraciones
If Form4.Check1.Value = 1 Then
Dim cad As String
For i = 1 To q
'fila
For j = 1 To q + 5
If Len(mq(j, i)) > 6 Then
cad = Mid(mq(j, i), 1, 6) & Space(2)
Else
cad = mq(j, i) & Space(2 + 6 - Len(mq(j, i)))
End If
Form3.Text1.Text = Form3.Text1.Text & cad
Next
Form3.Text1.Text = Form3.Text1.Text & vbCrLf
Form3.Text2.Text = Form3.Text2.Text & va(i) & vbCrLf
Next
Form3.Text1.Text = Form3.Text1.Text & "______________________________________________________________________________________________________________________________________________________________________" & vbCrLf
Form3.Text2.Text = Form3.Text2.Text & "___" & vbCrLf
End If
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Next
'________________________________________________________________________________
'ahora se coloca el departamento q tenga más afinidad con los ya colocados
'para ello se suman las columnas de afinidad de los departamentos ya colocados
Module4.representación
'For i = 1 To q
'Form3.List1.AddItem mm(1, i) & Space(5) & mm(2, i) & Space(5) & mm(3, i) & Space(5) & mm(4, i) & Space(5) & mm(5, i) & Space(5) & mm(6, i) & Space(5) & mm(7, i) & Space(5) & mm(8, i) & Space(5) & mm(9, i) & Space(5) & mm(10, i) & Space(5) & mm(11, i) & Space(5) & mm(12, i) & Space(5) & mm(13, i) & Space(5) & mm(14, i)
'Form3.List1.AddItem mn(1, i) & Space(5) & mn(2, i) & Space(5) & mn(3, i) & Space(5) & mn(4, i) & Space(5) & mn(5, i) & Space(5) & mn(6, i) & Space(5) & mn(7, i) & Space(5) & mn(8, i) & Space(5) & mn(9, i) & Space(5) & mn(10, i) & Space(5) & mn(11, i) & Space(5) & mn(12, i)
'Form3.List1.AddItem mla(1, i) & Space(5) & mla(2, i) & Space(5) & mla(3, i) & Space(5) & mla(4, i) & Space(5) & mla(5, i) & Space(5) & mla(6, i) & Space(5) & mla(7, i) & Space(5) & mla(8, i) & Space(5) & mla(9, i) & Space(5) & mla(10, i) & Space(5) & mla(11, i) & Space(5) & mla(12, i) & Space(5) & mla(13, i) & Space(5) & mla(14, i)
'Form3.List1.AddItem mla(1, i) & Space(5) & mla(2, i) & Space(5) & mla(3, i) & Space(5) & mla(4, i) & Space(5) & mla(5, i) & Space(5) & mla(6, i) & Space(5) & mla(7, i) & Space(5) & mla(8, i) & Space(5) & mla(9, i) & Space(5) & mla(10, i) & Space(5) & mla(11, i) & Space(5) & mla(12, i) & Space(5) & mla(13, i)
'Form3.List1.AddItem vv(i)
'Form3.List1.AddItem mo(1, i) & Space(5) & mo(2, i) & Space(5) & mo(3, i) & Space(5) & mo(4, i) & Space(5) & mo(5, i) & Space(5) & mo(6, i) & Space(5) & mo(7, i) & Space(5) & mo(8, i) & Space(5) & mo(9, i) & Space(5) & mo(10, i) & Space(5) & mo(11, i) & Space(5) & mo(12, i)
'Form3.List1.AddItem mp(1, i) & Space(5) & mp(2, i) & Space(5) & mp(3, i) & Space(5) & mp(4, i) & Space(5) & mp(5, i) & Space(5) & mp(6, i) & Space(5) & mp(7, i) & Space(5) & mp(8, i) & Space(5) & mp(9, i) & Space(5) & mp(10, i) & Space(5) & mp(11, i) & Space(5) & mp(12, i)
'Form3.List1.AddItem mq(1, i) & Space(5) & mq(2, i) & Space(5) & mq(3, i) & Space(5) & mq(4, i) & Space(5) & mq(5, i) & Space(5) & mq(6, i) & Space(5) & mq(7, i) & Space(5) & mq(8, i) & Space(5) & mq(9, i) & Space(5) & mq(10, i) & Space(5) & mq(11, i) & Space(5) & mq(12, i) & Space(5) & mq(13, i)
'Next
'Form3.Show
'Form5.Show
End Sub
e-REdING. Biblioteca de la Escuela Superior de Ingenieros de Sevilla.
