Excel SOMASES em larga escala no VBA

[feross]

Bom dia pessoal,

 

Preciso de uma ajuda de vocês.

Estou criando uma planilha para controle de estoque, com entrada e saída de itens em uma aba de banco de dados e outra aba com os itens disponíveis no estoque.

 

Criei uma formula simples de SOMASES, na qual ela soma as ENTRADAS e subtrai as com a soma das SAÍDAS e retorna o estoque atual. 

O problema é que quando eu replico a formula para os outros itens, que são muitos, a planilha fica extremamente pesada e a tendência é ficar ainda mais pesada com a entrada de novos itens e a alimentação do BD.

 

Uma "solução" que criei foi criar uma macro na qual ela faz esse procedimento de replicar a formula e na sequência e cola especial valores, porém esse procedimento também ficou pesado.

 

Pesquisei e vi uma solução com WorksheetFunction.SumIfs, porém não consegui aplicar. 

Gostaria de saber se vocês vêem alguma alternativa para esse problema? 

 

Agradeço desde já.

662359680_Project-Cpia.zip

[AfonsoMira]

@feross Eu cheguei nesse código, mas ele tambem demora algum tempo.

 

Sub teste()

    Dim Arg1 As Range 'Range a somar entrada
    Dim Arg2 As Range 'Primeiro range criterio entrada
    Dim Arg3 As Variant 'Primeiro Criterio entrada
    Dim Arg4 As Range 'Segundo range criterio entrada
    Dim Arg5 As Variant 'Segundo Criterio entrada
    
    Dim Arg6 As Range 'Range a somar saida
    Dim Arg7 As Range 'Primeiro range criterio saida
    Dim Arg8 As Variant 'Primeiro Criterio saida
    Dim Arg9 As Range 'Segundo range criterio saida
    Dim Arg10 As Variant 'Segundo Criterio saida
    

    Set Arg1 = ThisWorkbook.Sheets("BD").Range("F:F")
    Set Arg2 = ThisWorkbook.Sheets("BD").Range("A:A")
    Set Arg4 = ThisWorkbook.Sheets("BD").Range("E:E")
    
    Set Arg6 = ThisWorkbook.Sheets("BD").Range("F:F")
    Set Arg7 = ThisWorkbook.Sheets("BD").Range("A:A")
    Set Arg9 = ThisWorkbook.Sheets("BD").Range("E:E")
    
    'Criterio Entrada
    Arg3 = "ENTRADA"
    'Criterio Saida
    Arg8 = "SAÍDA"
    
    Dim ws As Worksheet
    Set ws = ActiveSheet
    Dim i As Long
    Dim ultimo As Long
    
    ultimo = ws.Cells(rows.count, 1).End(xlUp).Row
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False
    
    For i = 2 To ultimo
        Arg5 = ws.Cells(i, 1).Value
        Arg10 = ws.Cells(i, 1).Value
        ws.Cells(i, 3).Value = Application.WorksheetFunction.SumIfs(Arg1, Arg2, Arg3, Arg4, Arg5) - Application.WorksheetFunction.SumIfs(Arg6, Arg7, Arg8, Arg9, Arg10)
    Next
    
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.DisplayAlerts = True
    
    MsgBox "Atualizado com sucesso!"
    
End Sub

 

[feross]

@AfonsoMira Obrigado, como a BD é muito grande, é quase impossível deixa mais leve o calculo.

 

Mas essa macro ajudou muito. valeu