[Resolvido]Coluna calculada

Bom dia, alguém poderia me dar uma dica como fazer, deve ser simples
qual formula para preencher as colunas03 e 04

((coluna02 = valor.coluna01 - valoranterior.coluna01) está ja esta ok

coluna01        coluna02          coluna03         coluna04
100                                0                        0                    0
205                              105                   105                    0
150                              -55                      0                  -55
400                             250                   250                    0
500                             100                   100                    0
350                            -150                       0                -150
290                             -60                       0                  -60


csValorMoeda no BD

Caro Zaccariotto,

Crie um botão no seu formulário (ao clicar) e cole esses códigos. Irá criar uma tabela auxiliar exatamente com os dados que você informou. Faça as devidas adaptações e vai ficar tudo certo.

Function CriaTabs()
On Error GoTo trata_erro
Dim SqlV As String

MsgBox "Vamos criar Tabela ValorMoedaX........."


SqlV = "CREATE TABLE ValorMoedaX " & _
"(Id varchar (5), " & _
"Codigo Long NOT NULL, " & _
"Data DATE," & _
"Moeda VARCHAR(25) NOT NULL," & _
"ValorInicial MONEY NOT NULL," & _
"ValorAnterior MONEY," & _
"ValorX MONEY," & _
"ValorY MONEY," & _
"Nome CHAR(40)," & _
"CONSTRAINT PK_Id PRIMARY KEY (Codigo))"

DoCmd.RunSQL SqlV

MsgBox "Tabela ValorMoedaX criada com sucesso..."

Exit Function

trata_erro:

MsgBox "Erro gerado: " & Err.Number & " - " & Err.Description & "", vbCritical, "Erro"

Exit Function
'End

End Function

Private Sub Comando1_Click()
On Error GoTo trata_erro

Dim rsk As DAO.Recordset
Dim fncTabelaExiste As String
On Error Resume Next
Set rsk = CurrentDb.OpenRecordset("ValorMoedaX")
If Err Then
fncTabelaExiste = False
Else
fncTabelaExiste = True
End If
Set rsk = Nothing
If fncTabelaExiste = True Then
MsgBox "Tabela EXISTE"
DoCmd.DeleteObject acTable, "ValorMoedaX"
MsgBox "Tabela deletada para ser recriada..."
Else
MsgBox "Tabela NÃO EXISTE...Vai ser criada"

End If
Call CriaTabs

Dim DB As Database
Dim rs As DAO.Recordset
Dim rs2 As DAO.Recordset
Set DB = CurrentDb()
Dim PrimeiraVez As String
Dim ValorAnteriorX As Double
PrimeiraVez = "Sim"

Set rs = DB.OpenRecordset("SELECT * FROM [ValorMoeda]")
Set rs2 = DB.OpenRecordset("SELECT * FROM [ValorMoedaX]")

Do While Not rs.EOF
rs2.AddNew
If PrimeiraVez = "Sim" Then
rs2![Id] = rs![Id]
rs2![Codigo] = rs![Codigo]
rs2![Data] = rs![Data]
rs2![Moeda] = rs![Moeda]
rs2![ValorInicial] = rs![ValorInicial]
rs2![ValorAnterior] = 0
PrimeiraVez = "Não"
Else
rs2![Id] = rs![Id]
rs2![Codigo] = rs![Codigo]
rs2![Data] = rs![Data]
rs2![Moeda] = rs![Moeda]
rs2![ValorInicial] = rs![ValorInicial]
rs2![ValorAnterior] = rs![ValorInicial] - ValorAnteriorX
End If
ValorAnteriorX = rs![ValorInicial]
If rs2![ValorAnterior] > 0 Then
rs2![ValorX] = rs2![ValorAnterior]
rs2![ValorY] = 0
Else
rs2![ValorY] = rs2![ValorAnterior]
rs2![ValorX] = 0
End If

rs2.Update
rs2.Requery

rs.MoveNext
Loop

rs.Close
Set rs = Nothing
rs2.Close
Set rs2 = Nothing
DB.Close
Set DB = Nothing

Exit Sub
trata_erro:

'Call MsgBox "Erro gerado: " & Err.Number & " - " & Err.Description & "", vbCritical, "Erro"
Call MsgBox("Erro nº " & Err.Number & " - " & Err.Description)

MsgBox "TERMINADO..."

End Sub


Boa sorte,

Forte Abraço....virtual kkkk

Olá, Finformática

Você diz criar um formulário em branco com apenas um Botão chamado CriaTabs, e associa-lo ao código, se for isto eu fiz mas deu o seguinte erro:


A expressão ao clicar que você inseriu como definição da propriedade do evento gerou o seguinte erro: O membro já existe em um módulo de objeto do qual este modulo deriva.
"Este erro ocorre quando um evento não pôde ser executado porque não foi possível avaliar a localização da lógica do evento. Por exemplo, se a propriedade OnOpen de um formulário estiver definida como =[Field], o erro ocorrerá porque espera-se que um nome de evento ou macro seja executado quando o evento acontecer. "

sabe como resolver?

Caro Zaccariotto,

Desculpas amigo, me expressei mal. Crie o botão e cole essa parte: (ao clicar)
'------------------------------------------------------------------------------------------------------------------------------------
On Error GoTo trata_erro

Dim rsk As DAO.Recordset
Dim fncTabelaExiste As String
On Error Resume Next
Set rsk = CurrentDb.OpenRecordset("ValorMoedaX")
If Err Then
   fncTabelaExiste = False
Else
   fncTabelaExiste = True
End If
Set rsk = Nothing
If fncTabelaExiste = True Then
   MsgBox "Tabela EXISTE"
   DoCmd.DeleteObject acTable, "ValorMoedaX"
   MsgBox "Tabela deletada para ser recriada..."
Else
   MsgBox "Tabela NÃO EXISTE...Vai ser criada"

End If

'------------------------------------------------------------------------------------------------------------------------------------
Call CriaTabs
'------------------------------------------------------------------------------------------------------------------------------------
Dim DB As Database
Dim rs As DAO.Recordset
Dim rs2 As DAO.Recordset
Set DB = CurrentDb()
Dim PrimeiraVez As String
Dim MoedaXYZ As String
Dim ValorAnteriorX As Double
PrimeiraVez = "Sim"
'MoedaXYZ = InputBox("Informe Moeda?")

' CORRETO Set rs = DB.OpenRecordset("SELECT * FROM [ValorMoeda]")
Set rs = DB.OpenRecordset("SELECT * FROM [ValorMoeda] Where Moeda = " & "EURUSD")
'sql = "SELECT * FROM tblTeachers WHERE TeacherID=5"
If rs.RecordCount > 0 Then
   MsgBox "Registro Encontrado"
   DoCmd.Close
   DB.Close
Else
   MsgBox "Registro Encontrado"
End If

'"Select * FROM [tbl Pedido] WHERE [Numero do Pedido] = " & NumpedFat & ""


Set rs2 = DB.OpenRecordset("SELECT * FROM [ValorMoedaX]")

Do While Not rs.EOF
  rs2.AddNew
  If PrimeiraVez = "Sim" Then
      rs2![Id] = rs![Id]
      rs2![Codigo] = rs![Codigo]
      rs2![Data] = rs![Data]
      rs2![Moeda] = rs![Moeda]
      rs2![ValorInicial] = rs![ValorInicial]
      rs2![ValorAnterior] = 0
      PrimeiraVez = "Não"
   Else
      rs2![Id] = rs![Id]
      rs2![Codigo] = rs![Codigo]
      rs2![Data] = rs![Data]
      rs2![Moeda] = rs![Moeda]
      rs2![ValorInicial] = rs![ValorInicial]
      rs2![ValorAnterior] = rs![ValorInicial] - ValorAnteriorX
   End If
   ValorAnteriorX = rs![ValorInicial]
   If rs2![ValorAnterior] > 0 Then
      rs2![ValorX] = rs2![ValorAnterior]
      rs2![ValorY] = 0
   Else
      rs2![ValorY] = rs2![ValorAnterior]
      rs2![ValorX] = 0
   End If
       
      rs2.Update
      rs2.Requery
         
rs.MoveNext
Loop

rs.Close
Set rs = Nothing
rs2.Close
Set rs2 = Nothing
DB.Close
Set DB = Nothing

Exit Sub
trata_erro:
   
 'Call MsgBox "Erro gerado: " & Err.Number & " - " & Err.Description & "", vbCritical, "Erro"
 Call MsgBox("Erro nº " & Err.Number & " - " & Err.Description)

MsgBox "TERMINADO..."
'------------------------------------------------------------------------------------------------------------------------------------
'------------------------------------------------------------------------------------------------------------------------------------
'------------------------------------------------------------------------------------------------------------------------------------

Aqui abaixo cole a função para criar a tabela:

Function CriaTabs()
On Error GoTo trata_erro
Dim SqlV As String

   MsgBox "Vamos criar Tabela ValorMoedaX........."


  SqlV = "CREATE TABLE ValorMoedaX " & _
  "(Id varchar (5), " & _
  "Codigo Long NOT NULL, " & _
  "Data DATE," & _
  "Moeda VARCHAR(25) NOT NULL," & _
  "ValorInicial MONEY NOT NULL," & _
  "ValorAnterior MONEY," & _
   "ValorX MONEY," & _
   "ValorY MONEY," & _
  "Nome CHAR(40)," & _
  "CONSTRAINT PK_Id PRIMARY KEY (Codigo))"
 
  DoCmd.RunSQL SqlV

   MsgBox "Tabela ValorMoedaX criada com sucesso..."

   Exit Function

trata_erro:
   
   MsgBox "Erro gerado: " & Err.Number & " - " & Err.Description & "", vbCritical, "Erro"
   
   Exit Function
   'End

End Function
'----------------------------------------------------------------------------------------------------------------------------------------
'----------------------------------------------------------------------------------------------------------------------------------------

Do modo que havia falado antes realmente não tinha sentido.

Agora, Ao clicar, irá verificar se tabela auxiliar existe. Se existir, vai apagar e criar novamente, se não existir, cria. É aqui que chama a função para criar a tabela.
Continuando o código, em seguida, ler sua tabela "ValorMoeda", faz as devidas verificações e atualiza na tabela auxiliar "ValorMoedaX", conforme seu exemplo.

Espero que agora tenha sido mais claro.

Forte abraço.

Amigo, desculpe minha insistência, mas no VBA eu sou aprendiz ainda

segue o BD como ficou, eu não consegui rodar o código....

Caro amigo,

Veja aí se ajuda:

Abraços

Agora não deu erro, mas fica pensando e não abre nada....
o botão faz algumas perguntas, dou ok e o sistema fica pensando ou gerando algo e não sai disso.....

Meu caro,

O que você quer dizer com "sistema pensando"? Fica uma bolinha rodando na tela e não termina?

Abraço

exatamente isso!

Caro amigo,

Acho que mandei o bd errado. Veja agora.

Abraço

ok, agora funcionou, e ficou rápido.

para concluir o programa, ainda tenho outras colunas calculadas para fazer,

valorx = valor01 - ok
valorz = valor02 - ok
valor04=
valor05=
valor06=
valor07=

você teria disponibilidade para me ajudar, ficarei grato. (se tiver custo me avise) eu te passo as formulas a serem desenvolvidas.

Grato

Caro amigo,

Aqui não tem custos. Gosto de ajudar, Manda aí que, na medida do possível, vou tentando fazer e aprendendo também.

Abraços.

Não sei como te agradecer, vamos lá.

você criou as colunas (valorx) e (valorz esta tem que por ABS pra retornar valor absoluto)

valor03 = a média dos últimos 14 registros da coluna valorx
valor04 = a média dos últimos 14 registros da coluna valorz
valor05 = valor03/valor04
valor06 = C     |  1+ valor05 = A  |  100/A = B   |   100-b = C   |


esse valor06 é complicada!

segue em anexo modelo da planilha em excell que estou passando para access...

Essa tabela é fixa? Não é alimentada? Não sofre alterações?

Abraços

sim ela é alimentada mensalmente, apenas os campos seguintes:

Id       Codigo    Data       Moeda      ValorInicial


OBS: o Valor das colunas não são padrão moeda, são inteiro longo, sem digito!



a partir daí, inicia-se os cálculos das colunas seguintes, como o formulário será mais simples eu ainda não fiz, mas o formulário é tranquilo, o problema é a consulta, que vc esta criando.

Seria possível, colocar antes de acionar o Botão para criar a tabela, inserir um box pra selecionar a moeda, e ai a tabela ValorMoedaX será criada apenas com aos dados da moeda selecionada.

Sacca, não esqueci de você.

Veja mais uma parte, depois veremos o restante. Aos poucos...

Grande abraço.

Bom dia, combinado, já vou baixar.

O caminho é esse?

Sim, eu fiz algumas correções, segue o BD

Amigo,

Havia feito coisas do tipo, acho que não mandei o mais atualizado.

Abraços

Caro Amigo,

Olhe direitinho essa planilha Excel e veja que os intervalos da média estão incorretos. Logo na primeira média calculada não inclui a primeira célula do intervalo. Quando faz o copiar/colar não reflete ao solicitado. Por isso que os valores que calculo aqui começam corretos, pois os valores iniciais são zeros, depois nada bate.
Fiz os cálculos de diversos modos e todos com o mesmo resultado.

Verifique aí e diga algo.

Abraços

Boa noite, abri o BD que vc mandou, mas não esta calculando a média.
O correto é que a próxima coluna a ser criada é = media dos últimos 14 registros da coluna citada.

manda pra mim analisar o que vc fez que eu te retorno.

Grato.

Viu a mensagem anterior?

vi sim, mas ela não gera a coluna com valores médios dos registros anteriores, vi o código e está comentado as linhas

vou exemplificar em uma outra planilha com os nomes corretos das colunas e coloco aqui logo mais... ok

Estou me referindo a fórmula da planilha que não inclui a primeira linha (primeira célula) e o cálculo correto não bate.

Entendi seu raciocínio,

Valor04 = média dos últimos 14 registros de Valor02   |   porém os primeiro 13 registros de valor04 vão ficar distorcidos, na planilha os primeiros 13 registros de valor04 estão vazios pq não tem 14 registros anteriores em valor02

Valor05 = média dos últimos 14 registros de valor03   |   porém os primeiro 13 registros de valor05 vao ficar distorcidos, na planilha os primeiros 13 registros de valor05 estão vazios pq não tem 14 registros anteriores em
valor03


da um F2 em cima das celular de valor04 na planilha pra você ver como a formula executa

vc compreendeu agora?

Caro amigo,

Veja como está ficando os cálculos:

Id Codigo Data Moeda ValorInicial ValorAnterior ValorY ValorX Calculo14X Calculo14Y
1 1 01-jan-10 EURUSD 107050 0 0 0
1 2 01-fev-10 EURUSD 105440 -1610 -1610 0
1 3 01-mar-10 EURUSD 101502 -3938 -3938 0
1 4 01-abr-10 EURUSD 101764 262 0 262
1 5 01-mai-10 EURUSD 104421 2657 0 2657
1 6 01-jun-10 EURUSD 106366 1945 0 1945
1 7 01-jul-10 EURUSD 102922 -3444 -3444 0
1 8 01-ago-10 EURUSD 106535 3613 0 3613
1 9 01-set-10 EURUSD 102904 -3631 -3631 0
1 10 01-out-10 EURUSD 101871 -1033 -1033 0
1 11 01-nov-10 EURUSD 102618 747 0 747
1 13 01-dez-10 EURUSD 99771 -2847 -2847 0
1 14 01-jan-11 EURUSD 100071 300 0 300
1 15 01-fev-11 EURUSD 97139 -2932 -2932 0
1 16 01-mar-11 EURUSD 97034 -105 -105 0 680
1 17 01-abr-11 EURUSD 94484 -2550 -2550 0 680
1 18 01-mai-11 EURUSD 96835 2351 0 2351 848
1 19 01-jun-11 EURUSD 96314 -521 -521 0 830
1 20 01-jul-11 EURUSD 95517 -797 -797 0 658
1 21 01-ago-11 EURUSD 97743 2226 0 2226 868
1 22 01-set-11 EURUSD 105001 7258 0 7258 1526
1 23 01-out-11 EURUSD 99949 -5052 -5052 0 1268
1 24 01-nov-11 EURUSD 101717 1768 0 1768 1652
1 25 01-dez-11 EURUSD 102087 370 0 370 1678

Se todos os cálculos tem o ValorInicial como orígem, qual o motivo que essa primeira célula não
entra na média da coluna, não entra no cálculo e depois vc usa o copiar/colar para as outras células, aí é que bagunça tudo.
Os três primeiros valores, na sua planilha são: vazio, zero, zero. Aí não altera o cálculo. Quando começa os valores reais, bagunça tudo.
Esqueça os nomes das variáveis e valores absolutos. Vamos primeiros ver os cálculos corretos.

Caro amigo,
Na sua planilha a fórmula é essa: =MÉDIA(E3:E16). Não deveria ser E2:E16. A média é de 13, 14? Uma hora o valor entra, outra não.

Abraços

vamos lá, encontrei esses erros na sua fórmula, por isso não estão batendo os valores.

01) Os valores não são em formato Moeda, acho que é inteiro longo.

02) valor01 está invertido a soma, é o Preço.anterior - Preço.atual, você colocou atual-anterior

03) valor04 e valor05 tem que habilitar 4 casas decimais

04) valor06 tem que habilitar 6 casas decimais


acho que dai os valores vão fechar.

Caro amigo,

Conforme falei anteriormente, vamos no passo a passo. No momento estou querendo fazer os cálculos da planilha. Esqueça moeda, casas decimais, valores absolutos.
O que vocês se refere que código está errado: isso é um vetor/array, não estou subtraindo preço anterior de preço atual ou atual anterior. Estou pegando os primeiros 14 valores e fazendo a média. Depois excluo o primeiro valor e acrescento o novo 14º valor para cálculo da nova média. Depois excluo os dois primeiros valores e acrescento o novo 14º. e por aí vai. Isso é a lógica do código.

Finalmente, você quer: ler os primeiros 14 valores e calcular a média, depois a média do 2º até 15º valor, depois a média do 3º até 16º valor. É isso?
Quero saber qual o motivo do primeiro valor não entrar no cálculo se são os primeiros 14 valores?

Abraços

Vamos la, é porque a coluna valor1  célula D2 na planilha não foi calculado por não ter um campo anterior do Preço para Subtrair. e acabou ficando assim, mas na realidade o valor é 0



Finalmente, você quer: ler os primeiros 14 valores e calcular a média, depois a média do 2º até 15º valor, depois a média do 3º até 16º valor. É isso?
exatamente isso.

Quero saber qual o motivo do primeiro valor não entrar no cálculo se são os primeiros 14 valores?
Preço.Anterior a 01.01.2010 não existe,  estão essa linha deveria ser  0 na planilha, esse o motivo de não entrar no calculo, mas deveria entrar sim



Na sua formula, você inverteu o primeiro valor calculado. Veja valor01 está invertido a soma, é o Preço.anterior - Preço.atual, você colocou atual-anterior

acho que encaixou os pensamentos agora, certo!

Bom dia, Finformatica.

você precisa de mais alguma informação?

Boa noite amigo,

Estou vendo na medida possível. Acho que entendi a sua planilha. Aos poucos chegaremos lá. Estou meio atarefado com sisteminhas para candidatos políticos, mas estou sempre vendo alguma coisa sua. Qualquer necessidade, eu grito.

Abraços

Boa noite,

Finformática
Scandinavo

Temos mais um amigo do fórum aqui, ajudando, ele fez uma adaptação no seu código e avançou um pouco mais, mas necessita de outros ajustes.

ele colocou um código que calcula a média correto, mas está jogando o resultado um mês para a frente.


ValorX = Valor01
valorY = valor02
valorM = Valor03
....      = Valor04   esta esta faltando.

link do código que foi usado para calcular a média
http://allenbrowne.com/subquery-01.html#AnotherRecord

Amigo,

Estou com o mesmo problema. Exatamente a mesma coisa.
Vou ver o código dele.

Abraços

Cadê o código?
Estou trabalhando na média dos 14 lançamentos. O resto está quase pronto. Falta juntar vários códigos e colocá-los todos na sequência correta.

Abraços

segue o BD

Não entendi muito bem o código. Depois verei com mais calma.

Abraços

Caro Amigo,

Veja o enviado. Falta explicar direitinho a coluna Resultado que não entendi. Faça as devidas adaptações. Essa sua tabela tem, para cada moeda, mais de 14 registros? Menos que isso vai dar erro. Como faço média de 14 valores se não tenho todos?
Espero ter ajudado.

Abraços

Código:

Private Sub fncCalcula(strMoeda As String)
On Error GoTo trataErro

    Dim objRst                  As DAO.Recordset
    Dim objBD                   As DAO.Database
    Dim arrValorMoeda
    Dim intContador             As Integer
    Dim arr02Lista14(1 To 14)   As Long
    Dim arr03Lista14(1 To 14)   As Long
    
    Set objBD = CurrentDb
    Set objRst = objBD.OpenRecordset("select Data, ValorInicial from ValorMoeda where Moeda = """ & strMoeda & """ order by Data asc;")
    
    If objRst.RecordCount > 0 Then
    
        Call objRst.MoveLast: Call objRst.MoveFirst
        arrValorMoeda = objRst.GetRows(objRst.RecordCount)
        Call objRst.Close: Set objRst = Nothing
        
        Call objBD.Execute("delete * from temp_Moeda;")
        Set objRst = objBD.OpenRecordset("select * from temp_Moeda;", ,
        
        For intContador = LBound(arrValorMoeda, 2) To UBound(arrValorMoeda, 2)
        
            With objRst
        
                Call .AddNew
                
                    !cpData.Value = arrValorMoeda(0, intContador)
                    !cpPreco.Value = arrValorMoeda(1, intContador)
                
                    If intContador > 0 Then
                    
                        !cpValor01.Value = arrValorMoeda(1, intContador - 1) - arrValorMoeda(1, intContador)
                        !cpValor02.Value = IIf(!cpValor01.Value < 0, 0, !cpValor01.Value)
                        !cpValor03.Value = IIf(!cpValor01.Value > 0, 0, Abs(!cpValor01.Value))
                        
                        If intContador < 14 Then
                            Call fncMediaUltimos14(arr02Lista14, !cpValor02.Value)
                            Call fncMediaUltimos14(arr03Lista14, !cpValor03.Value)
                        Else
                            !cpValor04.Value = fncMediaUltimos14(arr02Lista14, !cpValor02.Value)
                            !cpValor05.Value = fncMediaUltimos14(arr03Lista14, !cpValor03.Value)
                            !cpValor06.Value = !cpValor04.Value / !cpValor05.Value
                            !cpResultado.Value = 100 - (100 / (!cpValor06.Value + 1))
                        End If
                    
                    End If
            
                Call .Update
                
            End With
        
        Next intContador
        
        Call objRst.Close: Set objRst = Nothing
        
    Else
        Call objRst.Close: Set objRst = Nothing
    End If
    
    
    
sair:
    On Error Resume Next
    Call objRst.Close: Set objRst = Nothing
    Exit Sub
    
trataErro:
    Call MsgBox(Err.Description, vbCritical, Err.Number)
    Resume sair:
    
End Sub

Private Function fncMediaUltimos14(ByRef arrUltimos14, ByVal lngNovoValor As Long)

    Dim bytContador     As Byte
    Dim lngAcumulado    As Long
    
    For bytContador = LBound(arrUltimos14) To (UBound(arrUltimos14) - 1)
        arrUltimos14(bytContador) = arrUltimos14(bytContador + 1)
        lngAcumulado = lngAcumulado + arrUltimos14(bytContador)
    Next bytContador
    
    arrUltimos14(UBound(arrUltimos14)) = lngNovoValor
    lngAcumulado = lngAcumulado + lngNovoValor
    
    fncMediaUltimos14 = lngAcumulado / 14

End Function

Vou fazer os testes e depois te dou um retorno
Grato por enquanto!

Caro Zacca,

Mais atual

Abraços

Blz,

Blz, Ficou ótimo agora, SENSACIONAL.

Agradeço imensamente vocês!

Parabéns ao Fórum

Forte Abraço. Valeu!!