Este fórum está sendo desativado

[xmiguelx]

Olá pessoal,

Tenho um relatório onde informo todos os lançamentos de crédito e débito.
Sempre quando lanço um débito, relaciono o documento do crédito informando na coluna S, e controlo o saldo no documento que originou o crédito.




Tenho um comando hoje que calcula o saldo do relatório todo, porém gostaria de fazer algo especifico para o documento que eu informar na coluna Y2, ou seja, se eu lançar um débito, gostaria que o saldo somente da ficha relacionada do crédito seja ajustado.

Gerei um exemplo para facilitar o entendimento, e estou deixando o comando que utilizo para calcular o saldo da planilha toda.

Deixei em colunas separada o calculo das macro apenas para que eu consiga adaptar ao meu projeto.



Coluna V já tem a macro que funciona para planilha toda, e ajuda que preciso é para coluna Y.

1) Sempre que tiver um lançamento de débito, será informado na coluna X o número da chave referente o documento de crédito.
2) O Número do documento do crédito está na coluna D.

Macro para calculo da planilha toda.

Código: Selecionar todos

Sub Saldo_Geral()
   
    Application.ScreenUpdating = False
    Application.DisplayStatusBar = False
    Application.Calculation = xlCalculationManual
   
   
    Dim uLin As Long
    Dim Lin As Integer
    Dim w As Worksheet
    uLin = Cells(Rows.Count, 2).End(xlUp).Row
    Set w = Sheets("CONTROL")
    For Lin = 4 To uLin
       
        If w.Cells(Lin, 7) = "ATIVA" And w.Cells(Lin, 13) = "CREDIT" Then
           
            SOMASE = Application.WorksheetFunction.SumIfs(w.Range("L4:L" & uLin), w.Range("G4:G" & uLin), "ATIVA", w.Range("s4:s" & uLin), w.Cells(Lin, 4))
           
            w.Cells(Lin, 22) = Int((w.Cells(Lin, 12) - SOMASE) * 100) / 100
           
           
        Else
           
            w.Cells(Lin, 22) = 0
           
        End If
        Next Lin
       
       
        Application.Calculation = xlCalculationAutomatic
        Application.DisplayStatusBar = True
        Application.ScreenUpdating = True

    End Sub

[xmiguelx]

Olá pessoal,

Consegui executar através do código abaixo o que estou precisando, porém está demorando muito tempo o processamento, creio que deve ser porque tem dois laços:

uLinha = Cells(Rows.Count, 2).End(xlUp).Row
Set w = Sheets("CONTROL")
For Linha = 4 To uLinha

uLin = Cells(Rows.Count, 2).End(xlUp).Row
For Lin = 4 To uLin

No primeiro arquivo que anexei, tem mais registros e leva muito tempo, e nesse que estou anexando tem menos registro e processa bem rápido.

Caso alguém possa me ajudar, agradeço.

Código: Selecionar todos

    Sub Saldo_DocControl()
        
        Application.ScreenUpdating = False
        Application.DisplayStatusBar = False
        Application.Calculation = xlCalculationManual
        
        
        Dim uLin As Long
        Dim Lin As Integer
        Dim w As Worksheet
        
        uLinha = Cells(Rows.Count, 2).End(xlUp).Row
        Set w = Sheets("CONTROL")
        For Linha = 4 To uLinha
            
            
            uLin = Cells(Rows.Count, 2).End(xlUp).Row
            For Lin = 4 To uLin
                
                If w.Cells(Lin, 7) = "ATIVA" And w.Cells(Lin, 13) = "CREDIT" Then
                    
                    
                    SOMASE = Application.WorksheetFunction.SumIfs(w.Range("L4:L" & uLin), w.Range("G4:G" & uLin), "ATIVA", w.Range("s4:s" & uLin), w.Cells(Lin, 4))
                    
                    If w.Cells(Lin, 4) = w.Cells(Linha, 19) And w.Cells(Linha, 2) = Range("Y2") Then
                        w.Cells(Lin, 25) = Int((w.Cells(Lin, 12) - SOMASE) * 100) / 100
                        
                        
                    End If
                End If
                Next Lin
                Next Linha
                
                
                Application.Calculation = xlCalculationAutomatic
                Application.DisplayStatusBar = True
                Application.ScreenUpdating = True
                
            End Sub