Notifications
Clear all

Somases pesado

6 Posts
3 Usuários
0 Reactions
1,727 Visualizações
(@carlosrgs)
Posts: 0
New Member
Topic starter
 

Boa tarde pessoal.

Dei uma pesquisada mas não achei.

Eu estou fazendo uma planilha para conciliação de dois relatórios e estou utilizando a fórmula SOMASES.

Mas o range é muito grande.

No mês que estou utilizando os dados para desenvolver a Planilha terei que utilizar em quase 8.000 linhas.

Eu insiro ela com macro.

    Range("F10").Select
    ActiveCell.FormulaR1C1 = _
        "=ROUND(SUMIFS(R10C4:R10009C4,R10C3:R10009C3,RC[-3],R10C5:R10009C5,RC[-1]),2)"

Depois copia a célula e colo a fórmula no range que eu quero.

Mas ao aplicar em 8.000 linhas demora muito, alguém sabe outra alternativa ?

Segue a planilha em anexo.

Eu sei que poderia utilizar a tabela dinâmica, mas para o que desejo tem que ser com fórmula, pois vou excluir com macro, o que estiver zerado.
Obrigado!

 
Postado : 20/10/2015 12:26 pm
(@carlosrgs)
Posts: 0
New Member
Topic starter
 

Só uma observação.

No arquivo em anexo até que executa rapido, mas no arquivo que quero incluir demora uns 4 minutos, eu acho absurdo isso rsrs!

 
Postado : 20/10/2015 12:34 pm
(@pfarias)
Posts: 0
New Member
 

O que você poderia fazer, se quiser continuar dessa forma, seria:

 Range("F10").Select
    ActiveCell.FormulaR1C1 = _
        "=ROUND(SUMIFS(R10C4:R10009C4,R10C3:R10009C3,RC[-3],R10C5:R10009C5,RC[-1]),2)"

application.Calculation=xlCalculationManual

  Range("F10").copy
  Range("F11:F12000").PasteSpecial xlPasteFormulas

application.Calculation=xlCalculationAutomatic

Mas o ideal seria mudar a forma de se trabalhar nesse processo.

 
Postado : 20/10/2015 1:09 pm
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Boa tarde carlosrgs,

Como a planilha "original" não é essa, acredito que fique bastante pesada mesmo.
Nesse caso, eu optaria em fazer tudo em VBA retornando apenas o valor desejado, pois a fórmula é recalculada toda hora.

Option Explicit

Public Sub Variacao()
Dim wsAtivo     As Worksheet
Dim i           As Long
Dim UltL        As Long
Dim Tempo1      As Double
Dim Tempo2      As Double
Dim Variacao    As Currency
Dim ValorSoma   As Currency

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Variacao = InputBox("Informe o valor da variação.")
    Tempo1 = Timer
    
    Set wsAtivo = ThisWorkbook.ActiveSheet
    UltL = wsAtivo.Cells(Rows.Count, 2).End(xlUp).Row
    
    For i = 10 To UltL
        ValorSoma = Format(Application.WorksheetFunction.SumIfs(Range("D10:D" & UltL), Range("C10:C" & UltL), Range("C" & i), Range("E10:E" & UltL), Range("E" & i)), "0,00")
        If ValorSoma >= (Variacao * (-1)) And ValorSoma <= Variacao Then
            wsAtivo.Range("F" & i).Value = "OK"
        Else
            wsAtivo.Range("F" & i).Value = "ERRO"
        End If
    Next i

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Tempo2 = Timer
    MsgBox ("Verificação finalizada com sucesso." & vbNewLine & "Tempo de execução: " & Tempo2 - Tempo1 & " segundos.")

End Sub

Qualquer coisa da o grito.
Abraço

 
Postado : 20/10/2015 1:40 pm
(@carlosrgs)
Posts: 0
New Member
Topic starter
 

Boa tarde.

Retornando as respostas.

pfarias o modo que você sugeriu só vou adiar a minha espera, pois na hora que eu incluo as fórmulas com o calculo manual, o excel não "pensa", mas ao ativar o calculo começa a demora.

Bernardo o modelo que me passou funcionou bem.

Mas na planilha Original os dados estão em colunas diferentes, exemplo.

Planilha que anexei
Coluna C = Conta
Coluna D = Valor
Coluna E = Documento
Coluna D = OK ou ERRO

No Arquivo Original está:
Coluna AT = Conta
Coluna AU = Valor
Coluna AV = Documento
Coluna AW = OK ou ERRO.

Eu alterei o código, e funcionou, poderia dar um OK se alterei corretamente ?

Option Explicit

Public Sub Variacao2()
Dim wsAtivo     As Worksheet
Dim i           As Long
Dim UltL        As Long
Dim Tempo1      As Double
Dim Tempo2      As Double
Dim Variacao    As Currency
Dim ValorSoma   As Currency

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Variacao = 0.1
    Tempo1 = Timer
    
    Set wsAtivo = ThisWorkbook.ActiveSheet
    UltL = wsAtivo.Cells(Rows.Count, 46).End(xlUp).Row
    
    For i = 10 To UltL
        ValorSoma = Format(Application.WorksheetFunction.SumIfs(Range("AU10:AU" & UltL), Range("AT10:AT" & UltL), Range("AT" & i), Range("AV10:AV" & UltL), Range("AV" & i)), "0,00")
        If ValorSoma >= (Variacao * (-1)) And ValorSoma <= Variacao Then
            wsAtivo.Range("AW" & i).Value = "OK"
        Else
            wsAtivo.Range("AW" & i).Value = "ERRO"
        End If
    Next i

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Tempo2 = Timer
    MsgBox ("Verificação finalizada com sucesso." & vbNewLine & "Tempo de execução: " & Tempo2 - Tempo1 & " segundos.")

End Sub

Hoje a empresa que eu trabalho está com problemas no servidor (uso Thin Client), então tive que usar um Pentium 4, e para executar o calculo todo demorou 1 min.
Só para comparar eu inclui as fórmulas para testar, só faltou sair fumaça do coolerzinho, e demorou qse 7 min, no Thin Client talvez faça em menos de 1 min.

Obrigado Bernardo e pfarias.

 
Postado : 22/10/2015 11:11 am
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

É isso mesmo carlosrgs.

Qualquer coisa da o grito.
Abraço

 
Postado : 22/10/2015 1:09 pm