Bb- Company Macros For An Inspiration

Páginas: 9 (2045 palabras) Publicado: 7 de agosto de 2012
Sub grafo_aux()
' borra los datos, pega la permutación y va creando el grafo auxiliar'
Worksheets("Grafo aux").Select
Range("c8:i500").Select
Selection.ClearContents
'Actualiza verificador'
Worksheets("Grafo aux").Select
Range("aa107").Activate
Selection.Copy
Range("aa9").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
'Calcula el numero de nodos'
Set qtynodos= Range("b8")
Do While (qtynodos <> "X")
Set qtynodos = qtynodos.Offset(1, 0)
Loop
nodos = qtynodos.Offset(-1, -1).Value
'valores iniciales para el ciclo'
Set head = Range("h8")
Set tail = Range("i8")
Set tiempo = Range("s8")
Set verifica = Range("AA8")
Set head_aux = Range("d8")
Set tail_aux = Range("e8")
Set tiempo_aux = Range("f8")
head.Value = (-1)
i = 1

'Ciclos paragenerar grafo auxiliar'

Do While (i <= nodos)
If (i = 1) Then
head.Value = head + 1
tail.Value = head + 1
parada = False
Else
head.Value = i - 1
tail.Value = head + 1
parada = False
End If
Do While Not (parada)
If (verifica = 1) Then
head_aux.Value = head
tail_aux.Value = tailtiempo_aux.Value = tiempo
Set head = head.Offset(1, 0)
Set tail = tail.Offset(1, 0)
Set tiempo = tiempo.Offset(1, 0)
Set head_aux = head_aux.Offset(1, 0)
Set tail_aux = tail_aux.Offset(1, 0)
Set tiempo_aux = tiempo_aux.Offset(1, 0)
Set verifica = verifica.Offset(1, 0)
resago_head = head.Offset(-1, 0)
head.Value =resago_head
resago = tail.Offset(-1, 0)
tail.Value = resago + 1
If (tail.Value > nodos) Then
verifica.Value = 0
Else
tail.Value = resago + 1
End If

Else
Worksheets("Grafo aux").Select
Range("h8:i8").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Sethead = Range("h8")
Set tail = Range("i8")
Set tiempo = Range("s8")
Set verifica = Range("aa8")
i = i + 1
parada = True
End If
Loop
Loop
End Sub

Sub bellman()
'Alista la pagina de bellman'
Worksheets("Algoritmo bellman").Select
Range("a3:d200").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContentsRange("h4:j200").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Range("n9:bl18").Select
Selection.ClearContents
Range("bn8:bo8").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
'copia los datos del grafo auxiliar'
Worksheets("Grafo Aux").Select
Range("d8:f8").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.CopyWorksheets("Algoritmo bellman").Select
Range("b3").Select
ActiveSheet.Paste

'Valores iniciales para el ciclo'
Set nodo = Range("g5")
Set etiq = Range("h4")
Set rez_etiq = Range("i4")
Set tail = Range("b3")
Set head = Range("c3")
Set dis = Range("d3")
Set pred = Range("j5")
Set c_k = Range("n9")
Set ruta = Range("o9")
nodos = Range("l2")
camiones = Range("l4")
k = 0
layer = 0
inf =Range("l3")
etiq.Value = 0
rez_etiq.Value = 0
Set etiq = etiq.Offset(1, 0)
Set rez_etiq = rez_etiq.Offset(1, 0)
'Llena eiqueta y rezago etiqueta con infinito'
Do While (etiq.Offset(0, -1) <> "X")
etiq.Value = inf
rez_etiq.Value = inf
Set etiq = etiq.Offset(1, 0)
Set rez_etiq = rez_etiq.Offset(1, 0)
Loop
Set etiq = Range("h4")
Set rez_etiq = Range("i5") 'Hasta acáesta bien'
i = 0
'Ciclo de bellman'
Do While (k < camiones)
k = k + 1
Range("o3").Select
Selection.Copy
Range("l5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
vi = Range("l5")
j = 0
Do While (i < vi)
i = i + 1
j = j + 1
Do While (tail = layer)...
Leer documento completo

Regístrate para leer el documento completo.

Estos documentos también te pueden resultar útiles

  • An Fora
  • Education necessary for company
  • An Eye For An Eye
  • An Lisis Eastman Kodak Company
  • Foro Macro
  • An Lisis Del Macro Entorno Seg N Porter
  • English Test American Inspiration For Teens 6. Unit 3 (7)
  • Here is an extra life for you.

Conviértase en miembro formal de Buenas Tareas

INSCRÍBETE - ES GRATIS