Pessoal, boa noite!
Antes de abrir este tópico, segui as orientações dos moderadores e realizei várias pesquisas relacionadas ao assunto. Encontrei alguns tópicos semelhantes, mas as soluções apresentadas não atenderam a minha necessidade. Como sou novo no fórum, eventualmente algum tópico relacionado ao tema pode ter passado despercebido, portanto de ante mão peço desculpas aos colegas.
Minha necessidade consiste em criar uma macro ou mesmo uma fórmula que calcule o preço médio ponderado de uma determinada ação, todas as vezes que a planilha recebe a inserção de uma nova compra.
Exemplificando:
Na coluna B temos os nomes das Corretoras
Na coluna C temos os nomes dos Ativos (ações de determinadas empresas)
Na coluna D temos a quantidade comprada
Na coluna F temos o preço médio de compra
Na coluna H temos o preço médio ponderado de Compra (nesta coluna é que necessito que o excel demonstre o resultado do cálculo)
Premissas:
1) O preço médio ponderado deve ser calculado por Corretora e por Ativo, ou seja, se e base de dados conter várias compras de um mesmo Ativo (ex. Vale3) realizadas em duas ou mais Corretoras (ex. Bradesco e Clear), a planilha deverá mostrar um preço médio ponderado para o Ativo Vale3 na Corretora Bradesco e um preço médio ponderado para o Ativo Vale3 na Corretora Clear.
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.
Estou inserindo um arquivo no tópico, visando ajudar no entendimento da minha necessidade.
Agradeço a ajuda dos colegas.
Luís
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
Desenvolvo pequenas soluções em VBA Excel a valores que variam entre R$ 50,00 a R$ 200,00. Se te interessar, entre no meu instagran (vba_excel_desenvolvimento)
Atenciosamente
Wagner Morel
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
Pietro Farias
Se foi resolvido suas dúvidas, lembre se de marcar o tópico como RESOLVIDO.
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