Otimizar Datas Considerando Peso

Este exercício mostra a aplicação de dicionários e objetos no Excel.

Introdução

Considere a tabela abaixo:

Cada período possui um início e fim, como pode ser observado, e cada possui um peso multiplicador. A coluna Resultado é o produto entre o Multiplicador e Dias Aproveitados, e o quadro suspenso Soma mostra a soma dessa coluna. O objetivo deste exercício é atingir o valor máximo no quadro suspenso respeitando as regras a seguir.

Deve-se verificar quantos dias com o maior peso cada período tem. Por exemplo: na linha 2, podemos aproveitar 8 dias, que são eles os dias 10 a 17. Os dias 18, 19 e 20 não podem ser aproveitados porque o multiplicador da linha abaixo para esses dias é maior.

Em outras palavras, um dia não pode ser utilizado mais de uma vez num período e ele deve ser atribuído à linha em que aparece com o maior multiplicador.

Solução

O resultado final com maior soma pode ser visto abaixo:

O problema pode ser resolvido de mais de uma forma diferente, pois existem dias que compartilham períodos com valores de multiplicador máximo iguais (como pode ser visto para os dias 85, 86 e 87 nas linhas 7 e 8).

Algoritmo

Num módulo de classe chamado cDateElement, cole o código abaixo:

Option Explicit
 
Public TopMultiplier As Long

Num módulo regular, cole o código abaixo:

Option Explicit
 
'Se quiser utilizar DateElements com ligação atual, adicione
'a biblioteca Microsoft Scripting Runtime nas referências.
 
Sub Main()
    Dim iRow As Long
    Dim iDay As Long
    Dim iKey As String
    Dim iDateElement As cDateElement
    Dim iCurrentMultiplier As Long
    Dim DateElements As Object 'Scripting.Dictionary
    Dim iNumDays As Long
    
    Set DateElements = CreateObject("Scripting.Dictionary")
    
    'Etapa 1: ler todos os dias existentes e atribuir o valor
    'de multiplicador máximo encontrado em cada um.
    With wsMain
        'O primeiro laço percorre todas as linhas
        For iRow = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row
            iCurrentMultiplier = .Cells(iRow, "C")
            
            'O segundo laço percorre todos os dias dentro de uma linha
            For iDay = .Cells(iRow, "A") To .Cells(iRow, "B")
                iKey = CStr(iDay)
                
                'Data já existe no dicionário?
                If DateElements.Exists(iKey) Then
                    Set iDateElement = DateElements(iKey)
                    
                    'Valor de multiplicador armazenado para esta data
                    'é menor que o valor de multiplicador atual?
                    If iDateElement.TopMultiplier < iCurrentMultiplier Then
                        iDateElement.TopMultiplier = iCurrentMultiplier
                    End If
                Else
                    'Data nova! Adicioná-la a coleção
                    Set iDateElement = New cDateElement
                    iDateElement.TopMultiplier = iCurrentMultiplier
                    DateElements.Add iKey, iDateElement
                End If
                
            Next iDay
        Next iRow
    
        'Etapa 2: varrer todas as linhas e verificar quantos dias
        'com multiplicador máximo cada período possui.
        For iRow = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row
            iCurrentMultiplier = .Cells(iRow, "C")
            
            For iDay = .Cells(iRow, "A") To .Cells(iRow, "B")
                iKey = CStr(iDay)
                
                If DateElements.Exists(iKey) Then
                    Set iDateElement = DateElements(iKey)
                    
                    If iDateElement.TopMultiplier = iCurrentMultiplier Then
                        iNumDays = iNumDays + 1
                        DateElements.Remove iKey
                    End If
                End If
            
            Next iDay
            
            .Cells(iRow, "D") = iNumDays
            iNumDays = 0
        Next iRow
    
    End With
End Sub

Dividi a resolução do problema em duas etapas: primeiro, descobri qual valor de multiplicador máximo cada dia possui e armazenei o objeto num dicionário (Dictionary). Depois, varri os períodos verificando quais de seus dias possuíam um multiplicador igual ao presente no dicionário e em caso positivo, incrementei a quantidade de dias aproveitados na variável iNumDays e removi seu respectivo objeto do dicionário.

Considerei que cada dia é um objeto (da classe cDateElement), pois só assim eu poderia conseguir alterar o valor de seu multiplicador no caso de na primeira etapa já existir um objeto de mesmo dia no dicionário. Além disso, armazenei todos os objetos na coleção DateElements.

Embora para este exemplo o código execute e dê a solução instantaneamente, o desempenho desse algoritmo é baixo, pois o número de visitas a cada dia cresce exponencialmente à medida que se acrescentam mais períodos. Provavelmente é possível fazer um algoritmo mais esperto que verifica apenas uma vez onde cada dia possui o multiplicador máximo e já totaliza em cada período. A estratégia que usei é bem inocente, pois aninha laços.

Desafio

Como fazer para que o algoritmo forneça a menor soma, ao invés da maior soma? Consegue alterar o algoritmo para chegar nessa resposta?

Download

Para fazer download da pasta de trabalho usada neste exercício, clique aqui.

Sobre Felipe Gualberto

Microsoft Most Valuable Professional (MVP) de Excel.
Esta entrada foi publicada em Dicas e marcada com a tag , , , , . Adicione o link permanente aos seus favoritos.