Buscar

ADM - VBA - Questões resolvidas

Faça como milhares de estudantes: teste grátis o Passei Direto

Esse e outros conteúdos desbloqueados

16 milhões de materiais de várias disciplinas

Impressão de materiais

Agora você pode testar o

Passei Direto grátis

Você também pode ser Premium ajudando estudantes

Faça como milhares de estudantes: teste grátis o Passei Direto

Esse e outros conteúdos desbloqueados

16 milhões de materiais de várias disciplinas

Impressão de materiais

Agora você pode testar o

Passei Direto grátis

Você também pode ser Premium ajudando estudantes

Faça como milhares de estudantes: teste grátis o Passei Direto

Esse e outros conteúdos desbloqueados

16 milhões de materiais de várias disciplinas

Impressão de materiais

Agora você pode testar o

Passei Direto grátis

Você também pode ser Premium ajudando estudantes
Você viu 3, do total de 16 páginas

Faça como milhares de estudantes: teste grátis o Passei Direto

Esse e outros conteúdos desbloqueados

16 milhões de materiais de várias disciplinas

Impressão de materiais

Agora você pode testar o

Passei Direto grátis

Você também pode ser Premium ajudando estudantes

Faça como milhares de estudantes: teste grátis o Passei Direto

Esse e outros conteúdos desbloqueados

16 milhões de materiais de várias disciplinas

Impressão de materiais

Agora você pode testar o

Passei Direto grátis

Você também pode ser Premium ajudando estudantes

Faça como milhares de estudantes: teste grátis o Passei Direto

Esse e outros conteúdos desbloqueados

16 milhões de materiais de várias disciplinas

Impressão de materiais

Agora você pode testar o

Passei Direto grátis

Você também pode ser Premium ajudando estudantes
Você viu 6, do total de 16 páginas

Faça como milhares de estudantes: teste grátis o Passei Direto

Esse e outros conteúdos desbloqueados

16 milhões de materiais de várias disciplinas

Impressão de materiais

Agora você pode testar o

Passei Direto grátis

Você também pode ser Premium ajudando estudantes

Faça como milhares de estudantes: teste grátis o Passei Direto

Esse e outros conteúdos desbloqueados

16 milhões de materiais de várias disciplinas

Impressão de materiais

Agora você pode testar o

Passei Direto grátis

Você também pode ser Premium ajudando estudantes

Faça como milhares de estudantes: teste grátis o Passei Direto

Esse e outros conteúdos desbloqueados

16 milhões de materiais de várias disciplinas

Impressão de materiais

Agora você pode testar o

Passei Direto grátis

Você também pode ser Premium ajudando estudantes
Você viu 9, do total de 16 páginas

Faça como milhares de estudantes: teste grátis o Passei Direto

Esse e outros conteúdos desbloqueados

16 milhões de materiais de várias disciplinas

Impressão de materiais

Agora você pode testar o

Passei Direto grátis

Você também pode ser Premium ajudando estudantes

Prévia do material em texto

i 
 
 UNIVERSIDADE FEDERAL FLUMINENSE 
DEPARTAMENTO DE ENGENHARIA DE PRODUÇÃO 
 
 
 
 
 
 
 
 
 
Trabalho de Administração Aplicada à Engenharia 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
Professor: WALDECY PEREIRA 
Aluna: MARINA PORTELLA DE CARVALHO 
 
 
Niterói, 30/04/2017 
 
 
 
 
ii 
 
SUMÁRIO 
1. OBJETIVO ......................................................................................................................... 3 
2. AULA 1: PREVISÃO DE DEMANDA - PARTE I .......................................................... 3 
2.1. Code 1 ................................................................................................................................. 3 
2.2. Code 2 ................................................................................................................................. 4 
2.3. Code 3 ................................................................................................................................. 5 
3. AULA 2: PREVISÃO DE DEMANDA - PARTE II ......................................................... 6 
3.1. Code 1 ................................................................................................................................. 6 
3.2. Code 2 ................................................................................................................................. 7 
4. AULA 3: MATERIALS REQUIREMENTS PLANNING ................................................ 8 
4.1. EOQ .................................................................................................................................... 8 
4.2. LFL ..................................................................................................................................... 9 
4.3. POQ .................................................................................................................................. 10 
4.4. POQ .................................................................................................................................. 12 
5. CPM & PERT ................................................................................................................... 13 
5.1. Code 1 ............................................................................................................................... 13 
 
3 
 
1. OBJETIVO 
O presente trabalho tem como principal objetivo a elaboração dos códigos utilizando a 
ferramenta VBA para solucionar os problemas propostos em aula. 
 
2. AULA 1: PREVISÃO DE DEMANDA - PARTE I 
 
2.1. Code 1 
Private Sub CommandButton1_Click() 
 
'1) Declarar variaveis 
Dim i, n As Integer 
Dim Demand_Array(51) As Double 
Dim Moving_Average_Array() As Double 
 
‘2) Criar um array que contem os dados da demanda 
For i = 0 To 5 
Demand_Array(i) = Cells(i + 3, 3).Value 
Next i 
 
'3) Criar um array que contem os dados da Media Movel de tamanho N - n 
n = 3 
ReDim Moving_Average_Array(51 - n) 
For i = 0 To 51 – n 
Moving_Average_Array(i) = Application.WorksheetFunction.Average(Range(Cells(i 
+ 3, 3), Cells(i + 2 + n, 3))) 
Next i 
 
'4) Antes do grafico.... 
Application.DisplayAlerts = False 
On Error Resume Next 
Sheets("Graph").Delete 
On Error GoTo 0 
Application.DisplayAlerts = True 
 
'5) Criar o grafico da demanda 
Charts.Add 
ActiveChart.ChartType = xlXYScatterSmoothNoMarkers 
ActiveWorkbook.Charts(1).Name = "Graph" 
ActiveChart.SeriesCollection.NewSeries 
ActiveChart.SeriesCollection(1).Values = Demand_Array 
ActiveChart.SeriesCollection(1).Name = "Demand" 
 
'6) Escrever a MM na planilha 
Cells(2, 4) = "MM(" & n & ")" 
For i = 0 To 51 – n 
Cells(i + 3 + n, 4).Value = Moving_Average_Array(i) 
 
 
4 
 
Next i 
 
'7) Formatar o range: centralizar, border, formatar numeros e primeira linha em negrito 
Range(Cells(2, 4), Cells(54, 4)).HorizontalAlignment = xlCenter 
Range(Cells(2, 4), Cells(54, 4)).Borders.LineStyle = xlContinuous 
Range(Cells(3, 4), Cells(54, 4)).NumberFormat = "0.00" 
Range(Cells(2, 2), Cells(2, 4)).Font.Bold = True 
End Sub 
2.2. Code 2 
Private Sub CommandButton1_Click() 
 
'1) Declarar variaveis 
Dim i, j, n As Integer 
Dim w1, w2, w3 As Double 
w1 = Cells(5,12) 
w2 = Cells(5,13) 
w3 = Cells(5,14) 
 
For i = 0 To 6 
'2) Cálculo MMP 
 Cells(i + 8, 4) = Cells(i + 5, 3) * w1 + Cells(i + 6, 3) * w2 + Cells(i + 7, 3) * w3 
 
'3) Cálculo do ME 
 Cells(i + 8, 5) = Cells(i + 8, 3) - Cells(i + 8, 4) 
 
'4) MSE 
 Cells(i + 8, 6) = (Cells(i + 8, 5)) ^ 2 
 
'5)MAE 
 Cells(i + 8, 7) = Abs(Cells(i + 8, 5)) 
 
 '6) MPE 
 Cells(i + 8, 8) = (Cells(i + 8, 5) / Cells(i + 8, 3)) 
 
'7) MAPE 
 Cells(i + 8, 9) = Abs(Cells(i + 8, 8)) 
 
'8) U1 
 Cells(i + 7, 10) = (Cells(i + 8, 5) / Cells(i + 7, 3)) ^ 2 
 
'9) U2 
 Cells(i + 7, 11) = ((Cells(i + 8, 3) - Cells(i + 7, 3)) / Cells(i + 7, 3)) ^ 2 
 Next i 
 
'10) Somatórios 
 For j = 0 To 6 
 
 
5 
 
Cells(15, j + 5) = Application.WorksheetFunction.sum(Range(Cells(7, j + 5), Cells(14, 
j + 5))) 
 Next j 
 
'11) Médias 
For j = 0 To 4 
 Cells(16, j + 5) = Cells(15, j + 5) / 7 
Next j 
 
'12) U-Theil 
 Cells(16, 11) = (Cells(15, 10) / Cells(15, 11)) ^ (0.5) 
 
End Sub 
 
2.3. Code 3 
Private Sub CommandButton1_Click() 
 
'1) Declarando variáveis 
Dim i, j As Integer 
Dim a, b, n, sum As Double 
a = Cells(4,8) 
b = Cells(5,8) 
n = Cells(6,8) 
 
'2) Regra 
Cells(8, 9) = Cells(8, 8) 
For i = 0 To 8 
 '3) Cálculo de Ai 
 Cells(i + 9, 9) = a * Cells(i + 9, 8) + (1 - a) * (Cells(i + 8, 9) + Cells(i + 8, 10)) 
 
'4) Cálculo de Ti 
 Cells(i + 9, 10) = b * (Cells(i + 9, 9) - Cells(i + 8, 9)) + (1 - b) * Cells(i + 8, 10) 
 
Next i 
 
'3) Cálculo de MH 
For i = 0 To 7 
 Cells(i + 10, 11) = Cells(i + 9, 9) + n * Cells(i + 9, 10) 
Next i 
 
'4) Cálculo de MSE 
sum = 0 
For i = 0 To 7 
 Cells(i + 10, 12) = (Cells(i + 10, 8) - Cells(i + 10, 11)) ^ 2 
 sum = sum + Cells(i + 10, 12) 
Next i 
Cells(18, 12) = sum 
Cells(19, 12) = sum / 8 
 
 
6 
 
End Sub 
 
3. AULA 2: PREVISÃO DE DEMANDA - PARTE II 
 
3.1. Code 1 
Private Sub CommandButton1_Click() 
 
'1) Declarar variaveis 
Dim i As Integer 
Dim alfa, beta, gama, media, mse, sum As Double 
alfa = Cells(2, 4) 
beta = Cells(3, 4) 
gama = Cells(4, 4) 
 
'2) Pegar valor dos pesos 
media = 0 
For i = 0 To 3 
media = media + Cells(i + 6, 6) 
Next i 
For i = 0 To 3 
 Cells(i + 6, 9) = Cells(i + 6, 6) / (media / 4) 
Next i 
 
'3) Inicializar A e T 
Cells(9, 8) = 0 
Cells(9, 7) = Cells(9, 6) / Cells(9, 9) 
 
'4) Calculo do metodo HW 
For i = 0 To 15 
Cells(i + 10, 7) = alfa * (Cells(i + 10, 6) / Cells(6 + i, 9)) + (1 - alfa) * (Cells(i + 9, 7) 
+ Cells(i + 9, 8)) 
 Cells(i + 10, 8) = beta * (Cells(i + 10, 7) - Cells(i + 9, 7)) + (1 - beta) * Cells(i + 9, 8) 
Cells(i + 10, 9) = gama * (Cells(i + 10, 6) / Cells(i + 10, 7)) + (1 - gama) * Cells(i + 6, 
9) 
 Cells(i + 10, 10) = (Cells(i + 9, 7) + Cells(i + 9, 8)) * Cells(i + 6, 9) 
Next i 
 
'5) Calculo do MSE 
mse = 0 
For i = 0 To 15 
 mse = (Cells(i + 10, 6) - Cells(i + 10, 10)) ^ 2 + mse 
Next i 
Cells(3, 10) = mse / 16 
 
'6) Fazer a previsao para o primeiro trimestre de 2015 
Cells(26, 7) = alfa * (Cells(26, 6) / Cells(22, 9)) + (1 - alfa) * (Cells(25, 7) + Cells(25, 8)) 
Cells(26, 8) = beta * (Cells(26, 7) - Cells(25, 7)) + (1 - beta) * Cells(25,8) 
Cells(26, 9) = gama * (Cells(26, 6) / Cells(26, 7)) + (1 - gama) * Cells(22, 9) 
 
 
7 
 
Cells(26, 10) = (Cells(25, 7) + Cells(25, 8)) * Cells(25, 9) 
 
'7) Grafico da demanda e da previsao 
Application.DisplayAlerts = False 
On Error Resume Next 
Sheets("Grafico").Delete 
On Error GoTo 0 
Application.DisplayAlerts = True 
 
Charts.Add 
ActiveChart.ChartType = xlLine 
ActiveWorkbook.Charts(1).Name = "Grafico" 
ActiveChart.SeriesCollection.NewSeries 
ActiveChart.SetSourceData Source:=Range("F6:F25") 
ActiveChart.SeriesCollection(1).Name = "Demand" 
ActiveChart.SeriesCollection(1).Format.Line.ForeColor.RGB = RGB(255, 0, 0) 
 
Charts("Grafico").SeriesCollection.Add Source:=Range("J6:J25") 
ActiveChart.SeriesCollection(2).Name = "HW" 
ActiveChart.SeriesCollection(2).Format.Line.ForeColor.RGB = RGB(0, 0, 255) 
 
End Sub 
3.2. Code 2 
Private Sub CommandButton1_Click() 
'1) Declarar variaveis 
Dim i As Integer 
Dim mse As Double 
 
'2) Calcular media movel 4 
For i = 0 To 15 
 Cells(i + 8, 7) = (Cells(i + 4, 6) + Cells(i + 5, 6) + Cells(i + 6, 6) + Cells(i + 7, 6)) / 4 
Next i 
 
'3) Calcular media movel centralizada 
For i = 0 To 14 
 Cells(i + 9, 8) = (Cells(i + 8, 7) + Cells(i + 9, 7)) / 2 
 
 '4) Calcular sazonalidade 
 Cells(i + 9, 9) = Cells(i + 9, 6) / Cells(i + 9, 8) 
Next i 
 
'5) Calcular indices sazonais e escever na planilha 
For i = 1 To 4 
Cells(i + 3, 12) = Application.WorksheetFunction.AverageIf(Range("D8:D23"), i, 
Range("I8:I23")) 
Next i 
 
'6) Calcular previsao 
 
 
8 
 
For i = 0 To 12 
 Cells(i + 8, 10) = Cells(i + 8, 8) * Cells(4, 12) 
 Cells(i + 9, 10) = Cells(i + 9, 8) * Cells(5, 12) 
 Cells(i + 10, 10) = Cells(i + 10, 8) * Cells(6, 12) 
 Cells(i + 11, 10) = Cells(i + 11, 8) * Cells(7, 12) 
 i = i + 3 
Next i 
Cells(8, 10).ClearContents 
 
'7) Calcular o MSE 
mse = 0 
For i = 0 To 14 
mse = (Cells(i + 9, 6) - Cells(i + 9, 10)) ^ 2 + mse 
Next i 
Cells(9, 12) = mse / 15 
 
'8) Fazer a previsao para o primeiro trimestre de 2015 
Cells(24, 7) = (Cells(20, 6) + Cells(21, 6) + Cells(22, 6) + Cells(23, 6)) / 4 
Cells(24, 8) = (Cells(22, 7) + Cells(23, 7)) / 2 
Cells(24, 10) = Cells(24, 8) * Cells(4, 12) 
 
'9) Fazer o grafico Demanda vs Previsao, em uma aba chamada Grafico-MM 
Application.DisplayAlerts = False 
On Error Resume Next 
Sheets("Grafico-MM").Delete 
On Error GoTo 0 
Application.DisplayAlerts = True 
 
Charts.Add 
ActiveChart.ChartType = xlLine 
ActiveWorkbook.Charts(1).Name = "Grafico-MM" 
ActiveChart.SeriesCollection.NewSeries 
ActiveChart.SetSourceData Source:=Range("F4:F23") 
ActiveChart.SeriesCollection(1).Name = "Demand" 
ActiveChart.SeriesCollection(1).Format.Line.ForeColor.RGB = RGB(255, 0, 0) 
 
Charts("Grafico-MM").SeriesCollection.Add Source:=Range("J4:J23") 
ActiveChart.SeriesCollection(2).Name = "HW" 
ActiveChart.SeriesCollection(2).Format.Line.ForeColor.RGB = RGB(0, 0, 255) 
 
End Sub 
4. AULA 3: MATERIALS REQUIREMENTS PLANNING 
 
4.1. EOQ 
Private Sub CommandButton1_Click() 
 
‘1)Declarar variaveis 
Dim EOQ, A, D, h, i As Integer 
 
 
9 
 
Dim hagazin, sum, soma As Double 
 
'2) Calculo do EOQ 
A = Cells(3, 2) 
D = Cells(4, 2) 
h = Cells(5, 2) 
hagazin = Cells(6, 2) 
 
EOQ = Round(((2 * A * D) / h) ^ (1 / 2), 0) 
Cells(8, 2) = EOQ 
Cells(5, 5) = Cells(8, 2) 
 
'3) Calculo do Estoque 
Cells(4, 5) = 0 
sum = 0 
soma = 0 
For i = 5 To 12 
 If Cells(4, i) < Cells(3, i) Then 
 Cells(5, i) = Cells(8, 2) 
 Else 
 Cells(5, i) = 0 
 End If 
 
'4) Calculo do Pedido 
 If Cells(5, i) = Cells(8, 2) Then 
 Cells(9, i) = A 
 Else 
 Cells(9, i) = 0 
 End If 
 Cells(6, i) = ((Cells(4, i) + Cells(5, i)) - Cells(3, i)) 
 If i < 12 Then 
 Cells(4, i + 1) = Cells(6, i) 
 End If 
 
 '5)Custo de Manutenção 
 Cells(10, i) = Cells(6, i) * hagazin 
 sum = sum + Cells(10, i) 
 soma = soma + Cells(9, i) 
Next i 
 
'6) Calculo do custo total 
Cells(11, 5) = sum + soma 
 
End Sub 
4.2. LFL 
Private Sub CommandButton1_Click() 
 
‘1)Declarar Variaveis 
 
 
10 
 
Dim A, i As Integer 
Dim hagazin, sum As Double 
 
A = Cells(3, 2) 
hagazin = Cells(4, 2) 
 
'2) Calculo do Estoque 
sum = 0 
For i = 0 To 7 
 Cells(4, i + 5) = 0 
 
'3) Calculo do Lote de produção 
 Cells(5, i + 5) = Cells(3, i + 5) 
 
'4) Calculo do Estoque final 
 Cells(6, i + 5) = 0 
 
'5) Calculo do custo pedido 
 Cells(9, i + 5) = A 
 
'6) Calculo do custo de manutencao 
 Cells(10, i + 5) = 0 
 sum = sum + Cells(9, i + 5) 
Next i 
 
'7) Calculo do custo total 
Cells(11, 5) = sum 
 
End Sub 
4.3. POQ 
Private Sub CommandButton1_Click() 
 
'1) Declarar Variavais 
Dim EOQ, A, D, h, i, j, t As Integer 
Dim hagazin, sum, soma As Double 
 
A = Cells(3, 2) 
D = Cells(4, 2) 
h = Cells(5, 2) 
hagazin = Cells(6, 2) 
 
‘2) Calculo do EOQ 
EOQ = Round(((2 * A * D) / h) ^ (1 / 2), 0) 
Cells(8, 2) = EOQ 
Cells(5, 5) = Cells(8, 2) 
 
t = 50 / (D / EOQ) 
Cells(9, 2) = t 
 
 
11 
 
 
 
'3) Calculo do lote de produção 
Cells(4, 5) = 0 
For j = 0 To 6 
 For i = 0 To 6 
 Cells(5, i + 5) = Cells(3, i + 5) + Cells(3, i + 6) 
 Cells(5, i + 6) = Cells(3, i + 6) - Cells(4, i + 6) 
 i = i + 1 
 Next i 
 
'4) Calculo do estoque final impar 
 Cells(6, j + 5) = Cells(5, j + 5) - Cells(3, j + 5) 
 
'5) Calculo do estoque inicial impar 
 Cells(4, j + 6) = Cells(6, j + 5) 
 
'6) Calculo do estoque final par 
 Cells(6, j + 6) = Cells(3, j + 6) - Cells(4, j + 6) 
 
'7) Calculo do estoque inicial par 
 Cells(4, j + 7) = Cells(6, j + 6) 
 j = j + 1 
Next j 
 
Cells(4, 13).ClearContents 
 
'8) Custo do pedido 
sum = 0 
soma = 0 
For j = 5 To 12 
 If Cells(6, j) = 0 Then 
 Cells(9, j) = 0 
 Else 
 Cells(9, j) = A 
 End If 
 
'9)Custo de Manutenção 
 Cells(10, j) = Cells(6, j) * hagazin 
 sum = sum + Cells(10, j) 
 soma = soma + Cells(9, j) 
Next j 
 
'10)Calculo do custo total 
Cells(11, 5) = sum + soma 
 
End Sub 
 
 
 
 
 
12 
 
4.4. POQ 
Private Sub CommandButton1_Click() 
 
'1) Declarar Variáveis 
Dim i, w, Z, j, A, PPB As Integer 
Dim h, soma, sum As Double 
 
'2) Calculo do PPB 
A = Cells(3, 2) 
h = Cells(4, 2) 
PPB = A / h 
Cells(8, 2) = PPB 
Cells(4, 5) = 0 
 
'3) Calculo do lote de produção 
For i = 5 To 12 
w = i + 1 
Z = i + 2 
If Abs(Cells(3, i) - Cells(8, 2)) = 0 Then 
 Cells(5, i) = Cells(3, i) 
 ElseIf Abs((Cells(3, i) + Cells(3, w)) - Cells(8, 2)) = 0 Then 
 Cells(5, i) = Cells(3, i) + Cells(3, w) 
 i = w 
ElseIf Abs((Cells(3, i) + Cells(3, w) + Cells(3, Z)) - Cells(8, 2)) = 0 
Then 
 Cells(5, i) = Cells(3, i) + Cells(3, w) + Cells(3, Z) 
 i = Z 
ElseIf Application.WorksheetFunction.And(Abs((Cells(3, i) + 
Cells(3, w) + Cells(3, Z)) - Cells(8, 2)) < Abs((Cells(3, i) + 
Cells(3, w)) - Cells(8, 2)), Abs((Cells(3, i) + Cells(3, w) + 
Cells(3, Z)) - Cells(8, 2)) < Abs(Cells(3, i) - Cells(8, 2))) Then 
 Cells(5, i) = Cells(3, i) + Cells(3, w) + Cells(3, Z) 
 i = Z 
ElseIf application.WorksheetFunction.And(Abs((Cells(3,i) + Cells(3, w)) - Cells(8, 2)) < Abs((Cells(3, i) + 
Cells(3, w) + Cells(3, Z)) - Cells(8, 2)), Abs((Cells(3, i) 
+ Cells(3, w)) - Cells(8, 2)) < Abs(Cells(3, i) - Cells(8, 
2))) Then 
 Cells(5, i) = Cells(3, i) + Cells(3, w) 
 i = w 
 Else 
 Cells(5, i) = Cells(3, i) 
End If 
Next i 
 
'4) Calculo do estoque final 
sum = 0 
soma = 0 
For i = 0 To 7 
 
 
13 
 
 
 If Abs(Cells(5, i + 5)) > Abs(Cells(3, i + 5)) Then 
 Cells(6, i + 5) = Abs(Cells(5, i + 5) - Cells(3, i + 5)) 
 Else 
 Cells(6, i + 5) = 0 
 End If 
 
'5)Calculo do Estoque inicial 
 Cells(4, i + 6) = Cells(6, i + 5) 
 Cells(4, 13).ClearContents 
 
'6) Custo do Pedido 
 If Cells(5, i + 5) > 0 Then 
 Cells(9, i + 5) = A 
 Else 
 Cells(9, i + 5) = 0 
 End If 
 
'7) Custo de Manutenção 
 Cells(10, i + 5) = Cells(6, i + 5) * h 
 sum = sum + Cells(10, i + 5) 
 soma = soma + Cells(9, i + 5) 
Next i 
 
'8) Calculo do custo total 
Cells(11, 5) = sum + soma 
 
End Sub 
 
5. PRODUÇÃO 
 
5.1. Code 1 
Private Sub CommandButton1_Click() 
 
'1) Declarar variaveis 
 
Dim pdt(5), udt(5), vet(5), vet2(5) As Double 
Dim i, j, sum, soma As Integer 
activities = Array("A", "B", "C", "D", "E", "F") 
 
'2) Preparar matriz de precedencias PDT e UDT 
 
For i = 3 To 8 
 sum = 0 
 For j = 0 To 5 
 If Cells(i, 3) Like "*" & activities(j) & "*" Then 
 Cells(i, 11 + j) = 1 
 Cells(i + 8, 11 + j) = 1 
 
 
14 
 
 Else 
 Cells(i, 11 + j) = 0 
 Cells(i + 8, 11 + j) = 0 
 End If 
 sum = sum + Cells(i, j + 11) 
 Cells(i, 17) = sum 
 Next j 
Next i 
 
For i = 0 To 5 
soma = 0 
 For j = 0 To 5 
 soma = soma + Cells(j + 11, i + 11) 
 Next j 
Cells(17, i + 11) = soma 
Next i 
 
'3) Calcular o PDT e escrever o resultado na planilha 
 
For j = 0 To 5 
 If Cells(j + 3, 17) = 0 Then 
 pdt(j) = Cells(j + 3, 4) 
 Cells(j + 3, 17) = "x" 
 End If 
Next j 
For i = 0 To 5 
 If Cells(i + 3, 17) = 1 Then 
 For j = 0 To 5 
 If Cells(i + 3, j + 11) = 1 Then 
 Cells(i + 3, j + 11) = 0 
 pdt(i) = Cells(i + 3, 4) + pdt(j) 
 End If 
 Next j 
 Cells(i + 3, 17) = 0 
 Cells(i + 3, 17) = "x" 
 
 End If 
Next i 
For i = 0 To 5 
 If Cells(i + 3, 17) = 2 Then 
 For j = 0 To 5 
 If Cells(i + 3, j + 11) = 1 Then 
 vet(j) = Cells(i + 3, 4) + pdt(j) 
 Cells(i + 3, j + 11) = 0 
 Cells(i + 3, 17) = Cells(i + 3, 17) - 1 
 End If 
 Next j 
 Cells(i + 3, 17) = "x" 
 pdt(i) = Application.WorksheetFunction.Max(vet) 
 End If 
 
 
15 
 
Next i 
 
'4) Escrever o resultado do tempo total na planilha 
For i = 0 To 5 
 Cells(i + 3, 6) = pdt(i) 
Next i 
Cells(10, 6) = Application.WorksheetFunction.Max(pdt) 
 
'5) Calcular UDT novo 
 
For j = 0 To 5 
 If Cells(17, j + 11) = 0 Then 
 udt(j) = Cells(10, 6) 
 Cells(17, j + 11) = "x" 
 End If 
Next j 
For i = 0 To 5 
 If udt(i) = Cells(10, 6) Then 
 For j = 0 To 5 
 If Cells(i + 11, j + 11) = 1 Then 
 Cells(i + 11, j + 11) = 0 
 udt(j) = udt(i) - Cells(i + 3, 4) 
 Cells(17, j + 11) = Cells(17, j + 11) - 1 
 If Cells(17, j + 11) = 0 Then 
 Cells(17, j + 11) = "x" 
End If 
 End If 
 Next j 
 End If 
Next i 
 
For i = 0 To 5 
 If Cells(17, i + 11) = 1 Then 
 For j = 0 To 5 
 If Cells(j + 11, i + 11) = 1 Then 
 vet2(i) = udt(j) - Cells(j + 3, 4) 
 If Application.WorksheetFunction.Or(vet2(i) < udt(i), udt(i) = 0) Then 
 udt(i) = vet2(i) 
End If 
 Cells(j + 11, i + 11) = 0 
 Cells(17, i + 11) = Cells(17, i + 11) - 1 
 End If 
 Next j 
 If Cells(17, i + 11) = 0 Then 
 Cells(17, i + 11) = "x" 
 End If 
 
 End If 
Next i 
For i = 0 To 5 
 
 
16 
 
Cells(i + 3, 7) = udt(i) 
Next i 
 
'6) Escrever o caminho critico na planilha 
For i = 0 To 5 
 If Cells(i + 3, 6) = Cells(i + 3, 7) Then 
 Cells(i + 3, 8) = Cells(i + 3, 2) 
 End If 
Next i 
 
End Sub

Outros materiais