Ir ao conteúdo
Regras do Clube do Hardware

Excel/VBA - Macro

Shuupa

Por Shuupa
em Microsoft Office e similares

Posts recomendados

Shuupa
 

Shuupa

Postado
Postado

Pessoal, eu criei um macro no Módulo 1 para resolver algumas equações em loop e tal. Esse macro têm entradas de variáveis no excel. Porém ele só funciona, quando eu dou play. Gostaria de saber se tem como colocar ele pra funcionar automaticamente quando a pessoa trocar o valor de umas dessas células de entrada, e dar enter. Por exemplo, a variavel B2 tinha "50" , quando ele colocar "40" , o macro dar play automatico e recalcular tudo.

Alguem pode me ajudar?

Agradeço desde já.

  • Membro VIP
Patropi
 

Patropi

Postado
  • Membro VIP
Postado

Boa noite

Seja bem vindo ao fórum!

Utilize o evento Change da planilha. Por exemplo:

 Private Sub Worksheet_Change(ByVal Target As Range)

 Seu código vai aqui

 End Sub

Um abraço.

Shuupa
 

Shuupa

Postado
  • Autor
Postado

Não deu certo não...

meu código ficou assim:


Private Sub Worksheet_Change(ByVal Target As Range)

  Dim Cd, Vt, Re, Cd1 As Variant, D, H, n As Integer
  Dim matriz(100, 2) As Single

        uo = Worksheets(1).Cells(1, 2).Value
        ug = Worksheets(1).Cells(2, 2).Value
        visc = Worksheets(1).Cells(3, 2).Value
        qo = Worksheets(1).Cells(4, 2).Value
        qg = Worksheets(1).Cells(5, 2).Value
        Z = Worksheets(1).Cells(6, 2).Value
        t = Worksheets(1).Cells(7, 2).Value
        Temp = Worksheets(1).Cells(8, 2).Value
        P = Worksheets(1).Cells(9, 2).Value

        n = 2
        Cd = 0.34
        Vt = 0.01186 * (((uo - ug) / ug) * (100 / Cd)) ^ 0.5
        Re = (0.0049 * ug * Vt * 100) / visc
        Cd1 = 0.34 + (3 / (Re ^ 0.5)) + (24 / Re)
        Do
        Cd = Cd1
        Vt = 0.01186 * (((uo - ug) / ug) * (100 / Cd)) ^ 0.5
        Re = (0.0049 * ug * Vt * 100) / visc
        Cd1 = 0.34 + (3 / (Re ^ 0.5)) + (24 / Re)
        Worksheets(1).Cells(n, 5).Value = Cd
        Worksheets(1).Cells(n, 6).Value = Cd1
        n = n + 1
        Loop Until ((Cd1 - Cd) < 0.00000001)

        D = (5058 * qg * ((Temp * Z) / P) * ((ug / (uo - ug)) * (Cd / 100)) ^ 0.5) ^ 0.5
        H = (8.565 * qo * t) / D ^ 2
        If D <= 36 Then
         Ls = (H + 76) / 12
        Else
         Ls = (H + D + 40) / 12
        End If
       Worksheets(1).Cells(2, 8).Value = Cd
       Worksheets(1).Cells(2, 9).Value = D
       Worksheets(1).Cells(2, 10).Value = H
       Worksheets(1).Cells(2, 11).Value = Ls
End Sub

Alguem ajuda? Obrigado de novo!

Shuupa
 

Shuupa

Postado
  • Autor
Postado
oPA...

TENTANDO AJUDAR!

TENTA ASSIM!

:rolleyes:

espero ter ajudado!:cool:

deu certo, porém o excel trava... ele recalcula, mas trava o arquivo...

sabe me dizer porque? brigado!

deejaywesley
 

deejaywesley

Postado
Postado

Opa!

Acho que sei...

Na hora que a macro roda, ela pega o valor de b2 então o comando que eu te passei, entende que quando a macro pega o valor a celula foi modificada, e começa tudo de novo...

Faça o seguinte...

Coloque em uma celula qualquer =b2

e mude seu codigo pra pegar o valor da celula que você coloco a formula =b2 e nao o de b2

e faça o teste pra ver se funciona!

aguardando

!:rolleyes:

Ah! e tambem mude a parte que te mandei para esta!

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Colunas As Range

Set Colunas = Range ("B2")

If Not Application.Intersect(Colunas, Range(Target.Address)) Is Nothing Then

linha = Target.Row

Seu código vai aqui

End If

End Sub

se quiser so alterar para este antes de tentar mudar a parte de usar outra celula com a formula =b2

pra ve se funciona!

aguardando!:rolleyes:

Shuupa
 

Shuupa

Postado
  • Autor
Postado
Opa!

Acho que sei...

Na hora que a macro roda, ela pega o valor de b2 então o comando que eu te passei, entende que quando a macro pega o valor a celula foi modificada, e começa tudo de novo...

Faça o seguinte...

Coloque em uma celula qualquer =b2

e mude seu codigo pra pegar o valor da celula que você coloco a formula =b2 e nao o de b2

e faça o teste pra ver se funciona!

aguardando

!:rolleyes:

Ah! e tambem mude a parte que te mandei para esta!

se quiser so alterar para este antes de tentar mudar a parte de usar outra celula com a formula =b2

pra ve se funciona!

aguardando!:rolleyes:

adicionando o meu codigo ai, parou de funcionar geral. Essa parada do B2 eu nao entendi.

deejaywesley
 

deejaywesley

Postado
Postado

opa....

vou tentar explicar...

é que se entendi direito, valo que é digitado em B2, como seu ex: la em cima de ta digitado 50 e a pessoa digita 40 a macro pega esse valor...

o que pode ta acontecendo, é que quando você muda o valor e da enter, a macro começa

a rodar, so que na hora que a macro pega o novo valor que foi digitado, é como se você tivese digitado e dado enter, então a macro começa a roda de novo ai trava... ai o que você pode fazer que eu falei....

por ex: na celula A1 você poe a formla =B2 ou seja

tudo que você digita em B2 vai aparecer em A1 certo?

ai na sua macro, na linha de comando em que ela busca o valor de B2 pra calcula,

você muda pra ela buscar o valor de A1, que é igual a B2

pra macro nao ativar a celula B2 que é a celula que faz a macro iniciar...

aguardando!:rolleyes:

Shuupa
 

Shuupa

Postado
  • Autor
Postado
opa....

vou tentar explicar...

é que se entendi direito, valo que é digitado em B2, como seu ex: la em cima de ta digitado 50 e a pessoa digita 40 a macro pega esse valor...

o que pode ta acontecendo, é que quando você muda o valor e da enter, a macro começa

a rodar, so que na hora que a macro pega o novo valor que foi digitado, é como se você tivese digitado e dado enter, então a macro começa a roda de novo ai trava... ai o que você pode fazer que eu falei....

por ex: na celula A1 você poe a formla =B2 ou seja

tudo que você digita em B2 vai aparecer em A1 certo?

ai na sua macro, na linha de comando em que ela busca o valor de B2 pra calcula,

você muda pra ela buscar o valor de A1, que é igual a B2

pra macro nao ativar a celula B2 que é a celula que faz a macro iniciar...

aguardando!:rolleyes:

Entendi o problema, ele age como se tivesse trocando o tempo todo... teria que fazer do tipo, "era 50, eu coloquei 60", se for 60 ele para de calcular pois ja é igual. Nesse caso que ta o meu ele fica recalculando mesmo eu mantendo o mesmo valor la e trava ne?

Se tiver como você trocar 1 valor pra mim, ou sei la... vou tirar uma screenshot de como ta o excel.

U2Dnq.jpg

deejaywesley
 

deejaywesley

Postado
Postado

tenta fazer assim...

no seu codigo, nessa parte!

uo = Worksheets(1).Cells(1, 2).Value

ug = Worksheets(1).Cells(2, 2).Value

visc = Worksheets(1).Cells(3, 2).Value

qo = Worksheets(1).Cells(4, 2).Value

qg = Worksheets(1).Cells(5, 2).Value

Z = Worksheets(1).Cells(6, 2).Value

t = Worksheets(1).Cells(7, 2).Value

Temp = Worksheets(1).Cells(8, 2).Value

P = Worksheets(1).Cells(9, 2).Value

mude o numero 2 que sta em vermelho para 3

e coloque em C2 a formula =B2

e faça o teste!

:rolleyes:

eu fiz uma aqui com base na imagem que você posto, e aqui deu certo!

baixa e da uma olhada http://www.4shared.com/file/ClFLkmAS/aqui_funciono.html

se nao funcionar, poste a sua em algum site para eu baixala!

Shuupa
 

Shuupa

Postado
  • Autor
Postado
tenta fazer assim...

no seu codigo, nessa parte!

uo = Worksheets(1).Cells(1, 2).Value

ug = Worksheets(1).Cells(2, 2).Value

visc = Worksheets(1).Cells(3, 2).Value

qo = Worksheets(1).Cells(4, 2).Value

qg = Worksheets(1).Cells(5, 2).Value

Z = Worksheets(1).Cells(6, 2).Value

t = Worksheets(1).Cells(7, 2).Value

Temp = Worksheets(1).Cells(8, 2).Value

P = Worksheets(1).Cells(9, 2).Value

mude o numero 2 que sta em vermelho para 3

e coloque em C2 a formula =B2

e faça o teste!

:rolleyes:

eu fiz uma aqui com base na imagem que você posto, e aqui deu certo!

baixa e da uma olhada http://www.4shared.com/file/ClFLkmAS/aqui_funciono.html

se nao funcionar, poste a sua em algum site para eu baixala!

Consegui não... ueaheauheauheau.. q *****..

http://www.4shared.com/office/CZ-hs2so/Trabalho_Vasos.html?

ta ai ... v se consegue algo e me fala.. obrigado!

deejaywesley
 

deejaywesley

Postado
Postado

Bom Dia!

olhei, e seu codigo tava meio diferente do que da planilha que te mandei...

mas mesmo diferente aqui no meu pc ele rodo beleza!

mas eu peguei o codigo da que te mandei e coloquei nele, pra ver se funciona ai...

e tem outra, pra no caso dessa nao funciona, que eu coloquei na coluna C em C2 a formula em =B2, e testei e funciono tambem...

se a outra na funciona ai, e essa segunda funciona, você so oculta a coluna C, que fica legalzinho!:lol:

http://www.4shared.com/rar/CqMso1u9/trabalho_vasos.html

aguardando!:rolleyes:

Shuupa
 

Shuupa

Postado
  • Autor
Postado
Bom Dia!

olhei, e seu codigo tava meio diferente do que da planilha que te mandei...

mas mesmo diferente aqui no meu pc ele rodo beleza!

mas eu peguei o codigo da que te mandei e coloquei nele, pra ver se funciona ai...

e tem outra, pra no caso dessa nao funciona, que eu coloquei na coluna C em C2 a formula em =B2, e testei e funciono tambem...

se a outra na funciona ai, e essa segunda funciona, você so oculta a coluna C, que fica legalzinho!:lol:

http://www.4shared.com/rar/CqMso1u9/trabalho_vasos.html

aguardando!:rolleyes:

Funciono muito! Boa mano... no Range invés de "b2", eu coloquei "b1:b9" ... ai funcino em todas...

deixa eu t perguntar uma outra coisa... eu gostaria q toda vez q ele recalculasse tudo, ele apagasse toda a coluna do cd e cd1... como q faz isso?

e se pra outra planilha do horizontal é só fazer a mesma coisa que você fez?/

vlwww!

deejaywesley
 

deejaywesley

Postado
Postado

pra outra planilha é a mesma coisa...

quanto a limpar...

coloque essa linha de comando

Range("E2:F1000").ClearContents

ficando assim....

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Colunas As Range

Set Colunas = Range ("B2")

If Not Application.Intersect(Colunas, Range(Target.Address)) Is Nothing Then

linha = Target.Row

Range("E2:F1000").ClearContents

Seu código vai aqui

End If

End Sub

E pronto! :lol:

Shuupa
 

Shuupa

Postado
  • Autor
Postado
pra outra planilha é a mesma coisa...

quanto a limpar...

coloque essa linha de comando

Range("E2:F1000").ClearContents

ficando assim....

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Colunas As Range

Set Colunas = Range ("B2")

If Not Application.Intersect(Colunas, Range(Target.Address)) Is Nothing Then

linha = Target.Row

Range("E2:F1000").ClearContents

Seu código vai aqui

End If

End Sub

E pronto! :lol:

Funciono 100%!!!!!

Valeu demais man!!!

Abração!!!

Arquivado

Este tópico foi arquivado e está fechado para novas respostas.

Ir à lista de tópicos

Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas comunidades sobre tecnologia do Brasil. Leia mais

Direitos autorais

Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais

Mais

×
×
  • Criar novo...

LANÇAMENTO!

eletronica2025-popup.jpg


CLIQUE AQUI E BAIXE AGORA MESMO!