Ir ao conteúdo
  • Cadastre-se

Deividson

Membro Júnior
  • Posts

    2
  • Cadastrado em

  • Última visita

Reputação

0
  1. Pessoal, boa tarde! Estou precisando de ajuda em um codigo do VBA que escrevi , como estou aprendendo e é o primeiro codigo que estou escrevendo , estou certo que há muitas oportunidades de otimização. Tenho uma planilha chamada Dados que uso de base para fazer os calculos, esta planilha tem 13k de linhas Aproximadamente a ideia do codigo é a seguinte : fazer a leitura dos dados da planilha e selecionar somente o conjunto de valores que atenderem 2 condições, colunas E e F, que estão na planilha resumo. E com este conjunto de dados executar a função forcast E demostrar o resultado na coluna AZ da planilha resumo da linha correspondente as restrições Exemplo Coluna E| Coluna F| ...| Coluna az| Restrição1 Restrição 2 Resultado do forcast usando os dados retirados da base que atendiam as restrições 1 e 2 Restrição 3 Restrição 4 Resultado do forcast usando os dados retirados da base que atendiam as restrições 3 e 4 na pratica o codigo está funcionando, porém demora bastante para executar. Teria alguma forma de otimizar para ele executar mais rápido? Obrigado Option Explicit Function Previsão_regressão() 'Declaração de variaveis Dim Itens() As Variant Dim Variavelx() As Double Dim Variavely() As Variant Dim UltimaLinha As Integer Dim i As Integer Dim Indice As Integer Dim data As Double Dim resultado As Double Dim IndiceValorProcurado As Integer Dim UltimaLinhaResumo As Integer Dim Dados As Worksheet Dim Resumo As Worksheet Dim WrkB As Workbook Dim WrkSDados As Worksheet Dim WrkSResumo As Worksheet Set WrkB = ThisWorkbook Set WrkSDados = WrkB.Sheets("Dados") Set WrkSResumo = WrkB.Sheets("Resumo") WrkSResumo.Range("at2").NumberFormat = "0.00" Application.Calculation = xlCalculationManual data = WrkSResumo.Range("at2").Value IndiceValorProcurado = 4 Indice = 1 ' atribui valor 1 para o indice UltimaLinha = WrkSDados.Cells(Rows.Count, "n").End(xlUp).Row ' verifica o valor da ultima linha preenchida UltimaLinhaResumo = WrkSResumo.Cells(Rows.Count, "f").End(xlUp).Row WrkSDados.Range("j1:j" & UltimaLinha).NumberFormat = "0.00" Retorno: If WrkSResumo.Range("ak" & IndiceValorProcurado) > 3 Then ReDim Itens(1 To UltimaLinha, 1 To 16) 'Redimenciona a matriz de 1 ate a ultima linha Itens() = WrkSDados.Range("a1:p" & UltimaLinha) ' preenche a matriz com os dados entre as colunas A1 e P ReDim Variavely(1 To UltimaLinha) 'Redimenciona a matriz de 1 ate a ultima linha ReDim Variavelx(1 To UltimaLinha) 'Redimenciona a matriz de 1 ate a ultima linha For i = LBound(Itens) To UBound(Itens) ' laço de repetição If Itens(i, 14) = WrkSResumo.Range("f" & IndiceValorProcurado) And Itens(i, 5) = WrkSResumo.Range("e" & IndiceValorProcurado) Then 'verifica se os itens na matriz é igual a célula do testo do itens Variavely(Indice) = Itens(i, 16) 'preenche o valor na matriz Variavelx(Indice) = Itens(i, 10) 'preenche o valor na matriz Indice = Indice + 1 'soma +1 no valor do indice End If Next i resultado = Application.WorksheetFunction.Forecast(data, Variavely, Variavelx) WrkSResumo.Range("az" & IndiceValorProcurado) = resultado End If If IndiceValorProcurado < UltimaLinhaResumo Then IndiceValorProcurado = IndiceValorProcurado + 1 GoTo Retorno End If WrkSResumo.Range("at2").NumberFormat = "dd/mm/yyyy" WrkSDados.Range("j1:j" & UltimaLinha).NumberFormat = "dd/mm/yyyy" Application.Calculation = xlCalculationAutomatic End Function
  2. Pessoal, bom dia! Estou pensando em comprar novos monitores para o meu PC, e queria uma dica de vocês de qual seria o melhor modelo de monitor para comprar e colocar as 3 telas sincronizadas lado a lado para jogos. Obrigado.

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...

Ebook grátis: Aprenda a ler resistores e capacitores!

EBOOK GRÁTIS!

CLIQUE AQUI E BAIXE AGORA MESMO!