Luis.p,

Bom dia!

Seja muito bem vindo ao fórum.

Para aproveitar ao máximo o fórum e sempre manter o mesmo de forma organizada, sugiro ler os tópico da regras abaixo:
viewtopic.php?f=7&t=16757
viewtopic.php?f=7&t=203
viewtopic.php?f=7&t=7903
viewtopic.php?f=7&t=3841
viewtopic.php?f=7&t=12600
viewtopic.php?f=7&t=3371

Bom dia!

O uso de tabela dinâmica + o powerpivot não seria a solução?
Veja o exemplo em anexo no link abaixo.
Arquivo Exemplo - Média Ponderada

Com este exemplo, é só adicionar no final da tabela as novas compras, que é retornado na tabela dinâmica.

Se precisar de ajuda para ativar o PowerPivot no Excel, segue o link ensinando:
Inicie o suplemento PowerPivot para Excel

Boa tarde Pietro Farias!
Primeiramente, obrigado pela dica acerca da utilização do powerpivot!!

Apenas por curiosidade. O cálculo que vc fez através do powerpivot, não seria o mesmo que inserir um campo calculado na tabela dinâmica para calcular a média?

Sobre a sua sugestão, vi a planilha que vc disponibilizou. O valores calculados refletem corretamente os preços médios ponderados por Corretora e Ativo, entretanto como solucionar a questões abaixo que descrevi nas premissas 2 e 3 no meu tópico:

2) Uma vez calculado o preço médio ponderado de um determinado Ativo por Corretora (ex. Vale3 - Bradesco), a macro deverá popular o resultado em todas as linhas da planilha que conter na coluna B o nome Bradesco e na coluna C o Ativo Vale3.

3)A cada inserção de novos dados na planilha o preço médio ponderado deverá ser recalculado e a nova média deverá ser demonstrada na coluna H e em todas as linhas que contém o respectivo Ativo e Corretora, com explicado no item 2 acima.

Exemplo:
DIA CORRETORA ATIVO QTDE PREÇO PREÇO MÉDIO PONDERADO
01/01/18 Bradesco Vale3 100 40,00 40,00 (Esse valor de 40,00 será substituído pelo valor de 41,33 e depois por 40,16)
02/01/18 Bradesco Vale3 200 42,00 41,33 (Esse valor de 41,33 será substituído pelo valor de 40,16)
03/01/18 Bradesco Vale3 300 39,00 40,16

Imagine que tenho uma planilha nos moldes que disponibilizei, entretanto contendo uma robusta base de dados com várias operadoras e ativos, formando inúmeras variáveis. O que preciso é quando eu digitar um novo dado na minha planilha (exemplo acima), ela envie as informações para outra base ou para uma tabela dinâmica, que, na sua sugestão, fará o cálculo do preço médio ponderado e devolverá imediatamente este cálculo para a minha planilha (coluna H - Preço Médio Ponderado).
É fato que a tabela dinâmica recalcula o preço médio ponderado a cada inserção de dados na base da minha planilha, todavia será preciso fazer uma atualização manual da tabela dinâmica, o que torna o procedimento inviável.
Eu sei que poderia criar uma macro para atualizar os dados da tabela dinâmica, mas a minha expectativa é ter um processo mais automático, ou seja, a partir da digitação de novos dados na planilha, uma macro rodaria e traria na coluna h da minha planilha o preço médio ponderado em todas as linhas cuja a corretora e o ativo forem os mesmos. No exemplo acima, os dias 01, 02 e 03 mostraria o preço médio ponderado de 40,16.

Exemplo 1:
Se vc vende todos os ativos (300), o preço médio que deve ficar fixado é o ultimo, em nosso exemplo é $ 11,00
Exemplo 2:
Se vc vende parcialmente os ativos (100) e até que ocorra outra compra, permanece a mesma média $11,00
Exemplo 3:
Se vc vende mais uma vez parcialmente os ativos (100) e até que ocorra outra compra, permanece a mesma média de $ 11,00

Obs. O seu código já estava fazendo isso. Em outras mensagens eu respondi o seu colega que as vendas não podiam interferir no cálculo do preço médio de compra, ao menos que ocorra nova compra.

Exemplo 4:
Após uma venda (exemplo qtde 100), quando ocorre nova compra (exemplo qtde 100 x preço $ 13,00, o código tem que ler o saldo que sobrou (nosso exemplo qtde 200 x preço médio $11,00) e somar a nova compra (qtde 100 e preço $ 13,00) e encontrar um novo preço médio, no exemplo $11,67.

Na planilha que te enviei simula todos esses cenários. Se mesmo após essa explicação não ficar claro, me avise que faço cópia da planilha que te enviei e monto os 3 cenários, mas o resultado é esse que te informei.

Tenha em mente que podem ocorrer uma ou várias vendas que o preço médio não vai mudar (foi por isso que pedi pra vc fixar o preço médio na linha da venda ou das vendas e o seu código fez isso). Agora assim que entrar uma nova compra, ai sim, o código tem que pega a quantidade remanescente que será multiplicada pelo preço médio atual (no nosso exemplo $11,00) e encontrar um novo preço médio, considerando os novos dados de quantidade e preço (no nosso exemplo $ 11,67).

klarc28,

Refiz os testes e informo que o código funcionou. Desta vez o note travou menos, mas tive que reinicia-lo.

Fica inviável usar o código se os travamentos forem frequentes. Além do que testei com 30 linhas de digitação, mas minha planilha terá cerca de 100 linhas por mês.

Você acha que o código ficaria mais rápido se ao invés de termos 12 planilhas, a gente ter apenas uma planilha e colocar no código mais uma variável mês/ano para calcular o preço médio ponderado? Neste exemplo, o código precisará encontrar as variáveis “ativo”, “corretora”, “jan/18” para fazer o cálculo.

Option Explicit
Dim tbcongelada(1000000, 5) As Variant
Dim colunaB(1000000) As String
Dim tbprincipal(3 To 100000, 7) As Variant
Dim linhaspreenchidas As Long

Public NomePlan As String
    
Sub CalcularPrecoMedio()
    
    'On Error GoTo fim
    Erase colunaB
    Dim linha As Long
    Dim linha2 As Long
    Dim precomedio As Double
    Dim achou As Boolean
    Dim corretora As String
    Dim ativo As String
    Dim linha3 As Long
    Dim linha7 As Long
    Dim LINFINAL As Long
    Dim LININICIAL As Long
    Dim LINHA9 As Long
    Dim PRECO As Double
    
    
    
    
    Dim achouvenda As Boolean
    
    
    Dim linTbPrincipal As Long
    Dim LR As Long
    linha3 = 3
    
    linhaspreenchidas = 3
    While Sheets(NomePlan).Range("F" & linhaspreenchidas).Value <> ""
        
        linhaspreenchidas = linhaspreenchidas + 1
    Wend
    LR = linhaspreenchidas - 1
    Dim PREENCHEU As Boolean
    For linTbPrincipal = 3 To LR
        PREENCHEU = False
        
        If Sheets(NomePlan).Range("F" & linTbPrincipal).Value <> "" Then
            If Sheets(NomePlan).Range("T" & linTbPrincipal).Value <> "" Then
                If Sheets(NomePlan).Range("U" & linTbPrincipal).Value <> "" Then
                    If Sheets(NomePlan).Range("AB" & linTbPrincipal).Value <> "" Then
                        PREENCHEU = True
                        
                        tbprincipal(linTbPrincipal, 0) = Sheets(NomePlan).Range("B" & linTbPrincipal).Value
                        tbprincipal(linTbPrincipal, 1) = Sheets(NomePlan).Range("F" & linTbPrincipal).Value
                        tbprincipal(linTbPrincipal, 2) = Sheets(NomePlan).Range("T" & linTbPrincipal).Value
                        tbprincipal(linTbPrincipal, 3) = Sheets(NomePlan).Range("U" & linTbPrincipal).Value
                        tbprincipal(linTbPrincipal, 4) = Sheets(NomePlan).Range("AB" & linTbPrincipal).Value
                        tbprincipal(linTbPrincipal, 5) = Sheets(NomePlan).Range("AC" & linTbPrincipal).Value
                    End If
                End If
            End If
        End If
        
    Next linTbPrincipal
    
    If PREENCHEU = False Then
        Exit Sub
    End If
    
    '   Application.EnableEvents = False
    
    '    linhaspreenchidas = 3
    '
    '
    '    While tbprincipal(linhaspreenchidas, 2) <> ""
    '
    '        linhaspreenchidas = linhaspreenchidas + 1
    '    Wend
    
    linha = 3
    While tbprincipal(linha, 2) <> ""
        If linhaspreenchidas > 4 Then
            If tbprincipal(linha, 0) <> "ZERADA" Then
                If tbprincipal(linha, 3) <> "" Then
                    If tbprincipal(linha, 1) <> "" Then
                        If VerificarQuantidade(tbprincipal(linha, 2), tbprincipal(linha, 1)) = True Then
                            MsgBox "Não insira mais vendas que compras."
                            GoTo fim
                        End If
                        
                        achou = False
                        achouvenda = False
                        
                        For linha2 = linha + 1 To linhaspreenchidas
                            
                            
                            
                            
                            If UCase(tbprincipal(linha, 2)) = UCase(tbprincipal(linha2, 2)) And _
                                UCase(tbprincipal(linha, 1)) = UCase(tbprincipal(linha2, 1)) Then
                                If UCase(colunaB(linha)) <> "B" Then
                                    If tbprincipal(linha, 3) <> "" Then
                                        If tbprincipal(linha, 4) <> "" Then
                                            
                                            achou = True
                                            corretora = tbprincipal(linha, 2)
                                            ativo = tbprincipal(linha, 1)
                                            
                                            For linha7 = 3 To linhaspreenchidas - 1
                                                If tbprincipal(linha7, 3) < 0 Then
                                                    achouvenda = True
                                                    Exit For
                                                End If
                                            Next linha7
                                            If achouvenda = False Then
                                                Call preenchertabelaauxiliar(corretora, ativo)
                                            Else
                                                Call preenchertabelaauxiliar2(corretora, ativo)
                                            End If
                                            ' Exit For
                                        End If
                                    End If
                                End If
                            End If
                            
                        Next linha2
                        
                        If achou = False Then
                            If UCase(colunaB(linha)) <> "B" Then
                                If tbprincipal(linha, 3) > 0 Then
                                    
                                    Sheets(NomePlan).Range("AC" & linha).Value = tbprincipal(linha, 4)
                                    tbprincipal(linha, 5) = tbprincipal(linha, 4)
                                    colunaB(linha) = "B"
                                Else
                                    
                                    
                                    
                                End If
                            End If
                        End If
                    End If
                End If
            End If
        Else
            Call preenchertabelaauxiliar(tbprincipal(3, 2), tbprincipal(3, 1))
            
        End If
        
        linha = linha + 1
    Wend
    
fim:
    '    Application.EnableEvents = True
End Sub


Sub preenchertabelaauxiliar(ByVal corretora As String, ByVal ativo As String)
    'Dim colunaB(1000000) As String
    
    On Error GoTo fim
    Dim linha As Long
    Dim linha2 As Long
    Dim precomedio As Double
    Dim achou As Boolean
    Dim linha3 As Long
    Dim linha4 As Long
    '  Dim linhaspreenchidas As Long
    Dim qtdvendas As Double
    Dim qtdgeralvendas As Double
    
    Dim QTD As Double
    Dim PRECO As Double
    Dim TOTAL As Double
    Dim QTDGERAL As Double
    Dim TOTALGERAL As Double
    achou = False
    ' linhaspreenchidas = 3
    linha3 = 3
    linha4 = 3
    '    While tbprincipal(linhaspreenchidas, 2) <> ""
    '
    '        linhaspreenchidas = linhaspreenchidas + 1
    '    Wend
    linha = 3
    ' Dim tbprincipal(1000000, 5) As Variant
    
    Dim tbAuxiliar(1000000, 5) As Variant
    While tbprincipal(linha, 2) <> ""
        
        
        For linha2 = linha + 1 To linhaspreenchidas
            If UCase(tbprincipal(linha, 2)) = UCase(corretora) And _
                UCase(tbprincipal(linha, 1)) = UCase(ativo) Then
                If UCase(colunaB(linha)) <> "B" Then
                    If tbprincipal(linha, 3) > 0 Then
                        tbAuxiliar(linha3, 0) = tbprincipal(linha, 2)
                        tbAuxiliar(linha3, 1) = tbprincipal(linha, 1)
                        tbAuxiliar(linha3, 2) = tbprincipal(linha, 3)
                        tbAuxiliar(linha3, 3) = tbprincipal(linha, 4)
                        linha3 = linha3 + 1
                        
                        
                        colunaB(linha) = "B"
                        
                    End If
                End If
            End If
            
            
        Next linha2
        linha = linha + 1
    Wend
    
    linha3 = 3
    QTD = 0
    PRECO = 0
    While tbAuxiliar(linha3, 0) <> ""
        
        QTD = tbAuxiliar(linha3, 2)
        PRECO = tbAuxiliar(linha3, 3)
        TOTAL = QTD * PRECO
        tbAuxiliar(linha3, 4) = TOTAL
        linha3 = linha3 + 1
    Wend
    
    linha3 = 3
    
    TOTALGERAL = 0
    QTDGERAL = 0
    While tbAuxiliar(linha3, 0) <> ""
        
        QTD = tbAuxiliar(linha3, 2)
        
        TOTAL = tbAuxiliar(linha3, 4)
        TOTALGERAL = TOTALGERAL + TOTAL
        QTDGERAL = QTDGERAL + QTD
        
        
        
        linha3 = linha3 + 1
    Wend
    
    precomedio = TOTALGERAL / QTDGERAL
    
    linha = 3
    linha3 = 3
    
    While tbprincipal(linha, 2) <> ""
        
        
        If UCase(tbprincipal(linha, 2)) = UCase(corretora) And _
            UCase(tbprincipal(linha, 1)) = UCase(ativo) Then
            If tbprincipal(linha, 3) > 0 Then
                ' If tbprincipal(linha, 3) > 0 Then
                
                colunaB(linha) = "B"
                Sheets(NomePlan).Range("AC" & linha) = precomedio
                
                'End If
            End If
        End If
        
        linha = linha + 1
    Wend
    
fim:
    
End Sub



Sub preenchertabelaauxiliar2(ByVal corretora As String, ByVal ativo As String)
    On Error GoTo fim
    Dim achouvenda(1000000) As Variant
    ' Dim colunaB(1000000) As String
    
    
    Dim LINHA20 As Long
    Dim linha As Long
    Dim linha2 As Long
    Dim precomedio As Double
    Dim achou As Boolean
    Dim QTD As Double
    Dim PRECO As Double
    Dim TOTAL As Double
    Dim qtd2 As Double
    Dim preco2 As Double
    Dim total2 As Double
    Dim QTDGERAL2 As Double
    Dim TOTALGERAL2 As Double
    Dim linha5 As Long
    Dim linha3 As Long
    Dim linha4 As Long
    Dim LININICIAL As Long
    Dim LINFINAL As Long
    Dim LINHA9 As Long
    'Dim linhaspreenchidas As Long
    Dim precomedio2 As Double
    'Dim tbprincipal2(1000000, 6) As Variant
    
    'Dim tbprincipal(3 To 1000000, 5) As Variant
    
    
    
    achou = False
    'linhaspreenchidas = 3
    linha3 = 3
    linha4 = 3
    '    While tbprincipal(linhaspreenchidas, 2) <> ""
    '
    '        linhaspreenchidas = linhaspreenchidas + 1
    '    Wend
    linha = 3
    
    
    
    linha3 = 3
    QTD = 0
    PRECO = 0
    While tbprincipal(linha3, 1) <> ""
        If tbprincipal(linha3, 0) <> "ZERADA" Then
            
            If UCase(tbprincipal(linha3, 2)) = UCase(corretora) And _
                UCase(tbprincipal(linha3, 1)) = UCase(ativo) Then
                QTD = tbprincipal(linha3, 3)
                If QTD > 0 Then
                    PRECO = tbprincipal(linha3, 4)
                Else
                    LINFINAL = linha3 - 1
                    For LINHA9 = LINFINAL To 3 Step -1
                        If tbprincipal(LINHA9, 3) > 0 Then
                            If tbprincipal(LINHA9, 0) <> "ZERADA" Then
                                If UCase(tbprincipal(LINHA9, 2)) = UCase(corretora) And _
                                    UCase(tbprincipal(LINHA9, 1)) = UCase(ativo) Then
                                    LININICIAL = LINHA9
                                End If
                            End If
                        End If
                        
                    Next LINHA9
                    PRECO = PRECODEVENDA(LININICIAL, LINFINAL, corretora, ativo)
                    
                End If
                TOTAL = QTD * PRECO
                tbprincipal(linha3, 6) = TOTAL
            End If
        End If
        linha3 = linha3 + 1
    Wend
    
    linha3 = 3
    Dim QTDGERAL As Double
    Dim TOTALGERAL As Double
    TOTALGERAL = 0
    QTDGERAL = 0
    While tbprincipal(linha3, 1) <> ""
        If tbprincipal(linha3, 0) <> "ZERADA" Then
            
            If UCase(tbprincipal(linha3, 2)) = UCase(corretora) And _
                UCase(tbprincipal(linha3, 1)) = UCase(ativo) Then
                QTD = tbprincipal(linha3, 3)
                
                TOTAL = tbprincipal(linha3, 6)
                TOTALGERAL = TOTALGERAL + TOTAL
                QTDGERAL = QTDGERAL + QTD
                
            End If
        End If
        
        linha3 = linha3 + 1
    Wend
    
    If QTDGERAL = 0 Then
        Dim j As Long
        Dim LINHA8 As Long
        
        
        
        linha2 = linhaspreenchidas - 1
        If tbprincipal(linha2, 3) < 0 Then
            'If tbprincipal(linha2, 0) = "ZERADA" Then
            ' If tbprincipal(linha2, 3) < 0 Then
            If Sheets(NomePlan).Range("AC" & linha2).Value = "" Then
                
                
                
                
                LINFINAL = linha2 - 1
                For LINHA9 = LINFINAL To 3 Step -1
                    If tbprincipal(LINHA9, 3) > 0 Then
                        'If tbprincipal(LINHA9, 0) <> "ZERADA" Then
                        If UCase(tbprincipal(LINHA9, 2)) = UCase(corretora) And _
                            UCase(tbprincipal(LINHA9, 1)) = UCase(ativo) Then
                            LININICIAL = LINHA9
                            'End If
                        End If
                    End If
                    
                Next LINHA9
                PRECO = PRECODEVENDA(LININICIAL, LINFINAL, corretora, ativo)
                
                
                Sheets(NomePlan).Range("AC" & linha2).Value = PRECO
                tbprincipal(linha2, 5) = PRECO
                colunaB(linha2) = "B"
            End If
        End If

    
    
    
    For LINHA8 = linha3 - 1 To 3 Step -1
        If tbprincipal(LINHA8, 0) <> "ZERADA" Then
            
            If tbprincipal(LINHA8, 2) = corretora And _
                tbprincipal(LINHA8, 1) = ativo Then
                If tbprincipal(4, 3) <> "" Then
                    Sheets(NomePlan).Range("B" & LINHA8).Value = "ZERADA"
                    tbprincipal(LINHA8, 0) = "ZERADA"
                    
                End If
            End If
        End If
        
        
    Next LINHA8
    
    For j = linha3 - 1 To 3 Step -1
        
        If tbprincipal(j, 1) = ativo Then
            
            If tbprincipal(j, 0) = corretora Then
                Exit For
                
            End If
            
        End If
        
    Next j
    precomedio = tbprincipal(j, 5)
Else
    precomedio = TOTALGERAL / QTDGERAL
    
    linha = 3
    
    
    While tbprincipal(linha, 2) <> ""
        If tbprincipal(linha3, 0) <> "ZERADA" Then
            
            
            If UCase(tbprincipal(linha, 2)) = UCase(corretora) And _
                UCase(tbprincipal(linha, 1)) = UCase(ativo) Then
                'If tbprincipal(linha, 3) > 0 Then
                If tbprincipal(linha, 0) <> "ZERADA" Then
                    If colunaB(linha) <> "B" Then
                        colunaB(linha) = "B"
                        Sheets(NomePlan).Range("AC" & linha).Value = precomedio
                    End If
                End If
            End If
        End If
        'End If
        linha = linha + 1
        
    Wend
End If


fim:

End Sub

Public Function VerificarQuantidade(ByVal corretora As String, ByVal ativo As String) As Boolean
    
    Dim contqtdpositiva As Double
    Dim contqtdnegativa As Double
    'Dim linhaspreenchidas As Long
    Dim linha As Long
    Dim linha2 As Long
    '  Dim corretora As String
    'Dim ativo As String
    Dim linha3 As Long
    Dim tbprincipal(1000000, 5) As Variant
    Dim ColunaC(1000000) As Variant
    
    Dim linha5 As Long
    Dim qtd2 As Double
    '    linhaspreenchidas = 3
    '    While tbprincipal(linhaspreenchidas, 2) <> ""
    '
    '        linhaspreenchidas = linhaspreenchidas + 1
    '    Wend
    linha3 = 3
    linha = 3
    While tbprincipal(linha, 2) <> ""
        
        
        For linha2 = linha + 1 To linhaspreenchidas
            If tbprincipal(linha, 0) = "ZERADA" Then
                Exit For
            End If
            If UCase(tbprincipal(linha, 2)) = UCase(corretora) And _
                UCase(tbprincipal(linha, 1)) = UCase(ativo) Then
                If UCase(ColunaC(linha)) = "B" Then
                    Exit For
                End If
                If UCase(ColunaC(linha)) <> "B" Then
                    If tbprincipal(linha, 0) <> "ZERADA" Then
                        
                        tbprincipal(linha3, 0) = tbprincipal(linha, 2)
                        tbprincipal(linha3, 1) = tbprincipal(linha, 1)
                        tbprincipal(linha3, 2) = tbprincipal(linha, 3)
                        tbprincipal(linha3, 3) = tbprincipal(linha, 4)
                        linha3 = linha3 + 1
                        ColunaC(linha) = "B"
                    End If
                End If
            End If
            
        Next linha2
        linha = linha + 1
    Wend
    
    contqtdpositiva = 0
    contqtdnegativa = 0
    linha5 = 3
    qtd2 = 0
    'preco2 = 0
    While tbprincipal(linha5, 1) <> ""
        
        
        qtd2 = tbprincipal(linha5, 2)
        If qtd2 > 0 Then
            contqtdpositiva = contqtdpositiva + qtd2
        Else
            contqtdnegativa = contqtdnegativa - qtd2
            
        End If
        
        
        linha5 = linha5 + 1
        
    Wend
    
    If contqtdnegativa > contqtdpositiva Then
        
        VerificarQuantidade = True
        
        
    End If
    
End Function





Function PRECODEVENDA(ByVal LINHAINICIAL As Long, ByVal LINHAFINAL As Long, ByVal corretora As String, ByVal ativo As String) As Double
    On Error GoTo fim
    Dim linha As Long
    Dim linha2 As Long
    Dim precomedio As Double
    Dim achou As Boolean
    Dim linha3 As Long
    Dim linha4 As Long
    ' Dim linhaspreenchidas As Long
    Dim qtdvendas As Double
    Dim qtdgeralvendas As Double
    
    Dim QTD As Double
    Dim PRECO As Double
    Dim TOTAL As Double
    Dim QTDGERAL As Double
    Dim TOTALGERAL As Double
    achou = False
    ' linhaspreenchidas = 3
    linha3 = 3
    linha4 = 3
    
    linha = 3
    ' Dim tbprincipal(1000000, 5) As Variant
    
    Dim tbAuxiliar(3 To 1000000, 5) As Variant
    'While tbprincipal(linha, 2) <> ""
    
    
    For linha2 = LINHAINICIAL To LINHAFINAL
        If UCase(tbprincipal(linha2, 2)) = UCase(corretora) And _
            UCase(tbprincipal(linha2, 1)) = UCase(ativo) Then
            If tbprincipal(linha2, 3) > 0 Then
                If tbprincipal(linha2, 0) <> "ZERADA" Then
                    
                    tbAuxiliar(linha3, 0) = tbprincipal(linha2, 2)
                    tbAuxiliar(linha3, 1) = tbprincipal(linha2, 1)
                    tbAuxiliar(linha3, 2) = tbprincipal(linha2, 3)
                    tbAuxiliar(linha3, 3) = tbprincipal(linha2, 4)
                    linha3 = linha3 + 1
                    
                End If
            End If
            
        End If
        
        
    Next linha2
    '  linha = linha + 1
    ' Wend
    
    linha3 = 3
    QTD = 0
    PRECO = 0
    While tbAuxiliar(linha3, 0) <> ""
        
        QTD = tbAuxiliar(linha3, 2)
        PRECO = tbAuxiliar(linha3, 3)
        TOTAL = QTD * PRECO
        tbAuxiliar(linha3, 4) = TOTAL
        linha3 = linha3 + 1
    Wend
    
    linha3 = 3
    
    TOTALGERAL = 0
    QTDGERAL = 0
    While tbAuxiliar(linha3, 0) <> ""
        
        QTD = tbAuxiliar(linha3, 2)
        
        TOTAL = tbAuxiliar(linha3, 4)
        TOTALGERAL = TOTALGERAL + TOTAL
        QTDGERAL = QTDGERAL + QTD
        
        
        
        linha3 = linha3 + 1
    Wend
    
    precomedio = TOTALGERAL / QTDGERAL
    PRECODEVENDA = precomedio
fim:
End Function

só como referencia
NÃO SEI SE OS CÁLCULOS ESTÃO CORRETOS PQ NÃO ENTENDI MUITO BEM O LANCE DE VENDA DE ATIVOS
existem varios pontos a se comentar sobre a planilha , mas...

colunas e TITULOS
F = Ativo
G = corretora
H = Qtde
i = Preço Compra / Vend
J = Preço Médio Ponderado "A MACRO NÃO TRABALHA NELA"

tabela de saida RESULTADO unico por ativo e corretora como referencia, é montado em um array
colunas e TITULOS:
M = Ativo
N = Corretora
O = Qtde
P =Valor Acumulado
Q = "Preço Médio Ponderado"
R = Resta

Sub ativos()
     Dim exc(1 To 250, 1 To 6)
     arr = Range("F3:i" & Cells(Rows.Count, "f").End(xlUp).Row).Value2
     For c = 1 To 3
          exc(1, c) = arr(1, c)
     Next
     exc(1, 4) = exc(1, 4) + (arr(1, 4) * arr(1, 3))
     exc(1, 6) = exc(1, 3)
     l2 = 1

     For l = 2 To UBound(arr, 1)
          For l3 = 1 To l2 Step 2
               If arr(l, 1) & arr(l, 2) = exc(l3, 1) & exc(l3, 2) Then
                    If arr(l, 3) > 0 Then
                         exc(l3, 3) = exc(l3, 3) + arr(l, 3)
                         exc(l3, 6) = exc(l3, 6) + arr(l, 3)
                         exc(l3, 4) = exc(l3, 4) + (arr(l, 4) * arr(l, 3))
                    Else
                    
                         If exc(l3, 6) < -arr(l, 3) Then
                              MsgBox "venda excede quantidade existente "
                              GoTo fim
                         End If
                         exc(l3 + 1, 3) = exc(l3 + 1, 3) + arr(l, 3)
                         exc(l3, 6) = exc(l3, 6) + arr(l, 3)
                         exc(l3 + 1, 5) = exc(l3, 4) / exc(l3, 3)
                    End If
                    GoTo tem
               End If
          Next

          l2 = l2 + 2
          For c = 1 To 3
               exc(l2, c) = arr(l, c)
          Next
          exc(l2, 4) = exc(l2, 4) + (arr(l, 4) * arr(l, 3))
          exc(l2, 6) = exc(l2, 3)
tem:
     Next
fim:
     For l3 = 1 To l2 Step 2
          exc(l3, 5) = exc(l3, 4) / exc(l3, 3)
     Next

     Range(Cells(3, 13), Cells(UBound(exc, 1) + 2, UBound(exc, 2) + 12)).Value2 = exc

End Sub

bem, pelo viso o assunto morreu,
eu ia pelo menos ajustar a macro para ter os cálculos corretos, mas pelo visto não fui bem vindo aqui

Sub ativos()
     Dim exc(1 To 250, 1 To 6)
     arr = Range("F3:j" & Cells(Rows.Count, "f").End(xlUp).Row).Value2
     For c = 1 To 3
          exc(1, c) = arr(1, c)
     Next
     exc(1, 4) = exc(1, 4) + (arr(1, 4) * arr(1, 3))
     exc(1, 6) = exc(1, 3)
     l2 = 1

     For l = 2 To UBound(arr, 1)
          For l3 = 1 To l2 Step 2
               If arr(l, 1) & arr(l, 2) = exc(l3, 1) & exc(l3, 2) Then
                    If arr(l, 3) > 0 Then
                         exc(l3, 3) = exc(l3, 3) + arr(l, 3)
                         exc(l3, 6) = exc(l3, 6) + arr(l, 3)
                         exc(l3, 4) = exc(l3, 4) + (arr(l, 4) * arr(l, 3))
                    Else
                    
                         If exc(l3, 6) < -arr(l, 3) Then
                              MsgBox "venda excede quantidade existente "
                              GoTo fim
                         End If
                         exc(l3 + 1, 3) = exc(l3 + 1, 3) + arr(l, 3)
                         exc(l3, 6) = exc(l3, 6) + arr(l, 3)
                         exc(l3 + 1, 5) = exc(l3, 4) / exc(l3, 3)
                         arr(l, 5) = exc(l3 + 1, 5)
                    End If
                    GoTo tem
               End If
          Next

          l2 = l2 + 2
          For c = 1 To 3
               exc(l2, c) = arr(l, c)
          Next
          exc(l2, 4) = exc(l2, 4) + (arr(l, 4) * arr(l, 3))
          exc(l2, 6) = exc(l2, 3)
tem:
     Next
fim:
     For l3 = 1 To l2 Step 2
          exc(l3, 5) = exc(l3, 4) / exc(l3, 3)
     Next

     Range(Cells(3, 13), Cells(UBound(exc, 1) + 2, UBound(exc, 2) + 12)).Value2 = exc
Range("F3:j" & Cells(Rows.Count, "f").End(xlUp).Row).Value2 = arr
End Sub

edcronos2. Boa noite!
Primeiramente todos os colegas cuja a intenção é de ajudar é sempre bem vindo.
Por motivo de saúde, estive ausente do fórum e não pude visualizar os seus posts. Inclusive, acabei de responder o colega wagner em outro tópico, o qual também ficou sem resposta durante este período.

Como foi dito anteriormente, a última versão disponibilizada pelo klarc28 está funcionando, porém é está bastante lenta.

COLUNAS e TITULOS
F = Ativo
T = corretora
U = Qtde
AB = Preço Compra / Vend
AC = Preço Médio Ponderado "A MACRO TRÁS O RESULTADO NELA"

O klarc28 criou uma condição na coluna B que mostra a palavra "ZERADA", todas as vezes que a soma dos ativos (compra = venda) ocorre. Entretanto, não preciso dessa coluna. Talvez seja ela que prejudicou a performance da planilha, pois nas versões anteriores o código rodava sem travamentos.

Se o klarc28 puder comentar, seria melhor, pois é algo técnico que não sei explicar.

Abraço,

Luís

Klarc28,
Conforme conversamos, a código está funcionando corretamente.
Agradeço mais uma vez o grande trabalho que você realizou neste código.
Muito obrigado.
Att
Luís