Ir ao conteúdo
  • Cadastre-se

Excel Criação de rotina em VBA


Ir à solução Resolvido por Márcio Rodrigues,

Posts recomendados

Olá, estou com um probema em fazer minha rotina VBA funcionar. Quero vincular minha rotina a um botão e que ao clicá-lo realize o seguinte: Insira as informações uma a uma de uma planilha em uma célula que fará os calculos  e gerará um resultado, quero pegar esse resultado  junto com a informação da outra tabela e colar em uma tabela a parte. Meu problema é que ao clicar neste botão aparentemente passa as informações pela célula mas não atualiza minha planilha, não sei o que está ocorrendo. Sei que é um pouco confuso, disponibilizo aqui a rotina. 

 

Private Sub CommandButton1_Click()

Dim linha As Integer

linha = 3
perfil = Sheets("Perfis lam. gerdau").Cells(4, 1).Value
peso = Sheets("Perfis lam. gerdau").Cells(4, 2).Value
volta:
linha = linha + 1

If Sheets("Perfis lam. gerdau").Cells(linha, 1).Value = "" Then GoTo sai

Sheets("calculo").Cells(5, 8).Value = Sheets("Perfis lam. gerdau").Cells(linha, 1).Value

    If Sheets("calculo").Cells(5, 13).Value <= 1 Then
        If Sheets("calculo").Cells(5, 13).Value < peso Then
        peso = Sheets("calculo").Cells(5, 13).Value
        perfil = Sheets("calculo").Cells(5, 8).Value
        Else
        End If
    Else
    End If
    
GoTo volta
sai:

Sheets("calculo").Cells(5, 8).Value = perfil

End Sub

Private Sub CommandButton2_Click()

Call otimizar


End Sub

Private Sub CommandButton3_Click()

End Sub
Sub otimizar()
Dim linha As Integer
Dim linha2 As Integer
linha2 = 5


Sheets("calculo").Range("R7:T1000").ClearContents
linha = 3
perfil = Sheets("Perfis lam. gerdau").Cells(4, 1).Value
peso = Sheets("Perfis lam. gerdau").Cells(4, 2).Value
volta:
linha = linha + 1

If Sheets("Perfis lam. gerdau").Cells(linha, 1).Value = "" Then GoTo sai

Sheets("calculo").Cells(5, 8).Value = Sheets("Perfis lam. gerdau").Cells(linha, 1).Value

    If Sheets("calculo").Cells(5, 11).Value <= 1 Then
    linha2 = linha2 + 1
        Sheets("calculo").Cells(5, 20).Value = "Perfil"
        Sheets("calculo").Cells(5, 21).Value = "Peso"
        Sheets("calculo").Cells(5, 22).Value = "%"
       Sheets("calculo").Cells(linha2, 20).Value = Sheets("calculo").Cells(5, 8).Value
       Sheets("calculo").Cells(linha2, 21).Value = Sheets("calculo").Cells(13, 13).Value
       Sheets("calculo").Cells(linha2, 22).Value = Sheets("calculo").Cells(5, 13).Value
        Else
    End If

    
GoTo volta
sai:

Range("R7:T8735").Select
    ActiveWorkbook.Worksheets("calculo").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("calculo").Sort.SortFields.Add Key:= _
        Range("S8:S160"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal
    With ActiveWorkbook.Worksheets("calculo").Sort
        .SetRange Range("R7:T160")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Sheets("calculo").Cells(5, 8).Value = Sheets("calculo").Cells(6, 20).Value
End Sub
 

 

Projeto_tcc_macro_teste.xlsx

Link para o post
Compartilhar em outros sites

Oi, Márcio.

Preciso pegar os perfis da coluna A da planilha "Perfis lam. gerdau" e passá-los  um a um pela célula H5, para que ela efetue os cálculos, gerando resultados  do perfil (H5), seu peso (M13) e porcentagem (M5), preciso jogar esses valores na tabela das colunas T,U e V da planilha "calculo".

Com essa rotina que eu tentei fazer ele calcula apenas quando eu executo a macro, mas não atualiza a tabela das colunas T,U e V quando clico no botão, também não atualiza se eu modificar as informações de entrada. 

Link para o post
Compartilhar em outros sites

Mais uma:

Private Sub CommandButton1_Click()
   Dim rgPerfLam As Range, i As Long
   With Worksheets("Perfis lam. gerdau")
     Set rgPerfLam = .Range(.[A4], .[A4].End(xlDown))
   End With
   With Worksheets("calculo")
     .Range(.[T6], .[T6].End(xlDown)).Resize(, 3).ClearContents
     Application.ScreenUpdating = False
       For i = 1 To rgPerfLam.Cells.Count
          .[H5] = rgPerfLam.Cells(i).Value
          .[T5].Offset(i, 0) = .[H5]
          .[T5].Offset(i, 1) = .[M13]
          .[T5].Offset(i, 2) = .[M5]
       Next i
     Application.ScreenUpdating = True
   End With
End Sub

 

  • Curtir 1
  • Obrigado 1
Link para o post
Compartilhar em outros sites

Crie uma conta ou entre para comentar

Você precisa ser um usuário para fazer um comentário

Criar uma conta

Crie uma nova conta em nossa comunidade. É fácil!

Crie uma nova conta

Entrar

Já tem uma conta? Faça o login.

Entrar agora

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

×
×
  • Criar novo...

Aprenda a ler resistores e capacitores

EBOOK GRÁTIS!

CLIQUE AQUI E BAIXE AGORA MESMO!