Notifications
Clear all

Código demora para executar

9 Posts
5 Usuários
0 Reactions
1,526 Visualizações
 hc3
(@hc3)
Posts: 8
Active Member
Topic starter
 

Olá galera,

eu tenho uma planilha onde tenho que converter unidades em caixa por produto, fiz esse código vba para me ajudar com isso mas ele está demorando muito para executar
sou novo em programação com excell, quando executo esse código o excell trava por uns 15 min mais ou menos, a planilha tem pouco mais de 75 000 de linhas.
segue i código:

Public Sub converteUnidade()

    Dim fatorUnidadePorCaixa As Integer
    Dim qtdOriginalBonRev As Integer
    Dim qtdOriginalBonFab As Integer

    Dim qntCaixaBonRev As Integer
    Dim qntUnidadeBonRev As Integer

    Dim qntCaixaBonFab As Integer
    Dim qntUnidadeBonFab As Integer




    For RowIndex = 2 To Cells(Rows.Count, "A").End(xlUp).Row

        For colIndex = 11 To 16

            Cells(RowIndex, colIndex).Select
            ' COLUNA K - UNIT QTD
            ' FATOR PARA CONVERSÃO
            If colIndex = 11 Then
                fatorUnidadePorCaixa = Cells(RowIndex, colIndex)
            End If

            ' COLUNA M - QTD VDA S/BON
            ' DESCONSIDERAR - USAR PARA PLAN ESTOQUE
'            If colIndex = 13 Then
'                qntcaixaEST = Cells(RowIndex, colIndex)
'            End If

            ' COLUNA P - QTD TOTAL DE BON EM UND
            ' CONVERTE BONIFICAÇÃO FABRICA
            If colIndex = 14 Then
                qtdOriginalBonRev = Cells(RowIndex, colIndex)
                qntCaixaBonRev = qtdOriginalBonRev  fatorUnidadePorCaixa
                qntUnidadeBonRev = qtdOriginalBonRev Mod fatorUnidadePorCaixa
            End If

            ' COLUNA P - QTD TOTAL DE BON EM UND
            ' CONVERTE BONIFICAÇÃO FABRICA
            If colIndex = 15 Then
                qtdOriginalBonFab = Cells(RowIndex, colIndex)
                qntCaixaBonFab = qtdOriginalBonFab  fatorUnidadePorCaixa
                qntUnidadeBonFab = qtdOriginalBonFab Mod fatorUnidadePorCaixa
            End If

        Next colIndex

        ' QNT EM CIAXA/UNIDADE BONIFICAÇÃO REVENDA
        Cells(RowIndex, 17).Value = qntCaixaBonRev
        Cells(RowIndex, 18).Value = qntUnidadeBonRev


        ' QNT EM CIAXA/UNIDADE BONIFICAÇÃO FABRICA
        Cells(RowIndex, 19).Value = qntCaixaBonFab
        Cells(RowIndex, 20).Value = qntUnidadeBonFab

    Next RowIndex

End Sub
 
Postado : 07/12/2016 1:23 pm
brunoxro
(@brunoxro)
Posts: 698
Honorable Member
 

Boa tarde hc3,

Você pode disponibilizar um planilha de exemplo, não precisa ser com os 75 mil linhas, umas 10 já tá bom.
Acho que dá para tirar o .Select, colocar uns With e talvez mudar esse For.

att,

 
Postado : 07/12/2016 1:44 pm
(@mprudencio)
Posts: 2749
Famed Member
 

75000 linhas e bastante dependendo de memoria, processador entre outros componentes do computador.

Marcelo Prudencio
Microsoft Excel Brasil no Facebook

"Começar já é a metade do caminho."
Autor Desconhecido

Simplifica que simples fica.
Nicole Tomazella.

"O Simples é Sempre Melhor Que o Complicado"
Jorge Paulo Lemann.

 
Postado : 07/12/2016 2:37 pm
DJunqueira
(@djunqueira)
Posts: 772
Prominent Member
 

Parece q o código está calculando uma linha por vez quando poderia calcular toda a coluna.

Se sua dúvida foi respondida marque o tópico como RESOLVIDO usando o botão com marca verde.

 
Postado : 07/12/2016 2:39 pm
(@edcronos2)
Posts: 346
Reputable Member
 

a primeira coisa é que vc tem um loop dentro de outro loop e comparador logico sem necessidade

para que fazer um loop de 11 até 16 e depois comparar se o loop está num valor se vc vai usar o valor fixo?

        For colIndex = 11 To 16

            If colIndex = 11 Then
                fatorUnidadePorCaixa = Cells(RowIndex, colIndex)
            End If

por que não assim?

                fatorUnidadePorCaixa = Cells(RowIndex, 11)

só se usa comparador quando o valor muda
nesse caso vai ser sempre a coluna 11 na linha corrente

Public Sub converteUnidade()

    Dim fatorUnidadePorCaixa As Integer
    Dim qtdOriginalBonRev As Integer
    Dim qtdOriginalBonFab As Integer
    Dim qntCaixaBonRev As Integer
    Dim qntUnidadeBonRev As Integer
    Dim qntCaixaBonFab As Integer
    Dim qntUnidadeBonFab As Integer

    For RowIndex = 2 To Cells(Rows.Count, "A").End(xlUp).Row

                fatorUnidadePorCaixa = Cells(RowIndex, 11).Value2
                qtdOriginalBonRev = Cells(RowIndex, 14).Value2
                qntCaixaBonRev = qtdOriginalBonRev  fatorUnidadePorCaixa
                qntUnidadeBonRev = qtdOriginalBonRev Mod fatorUnidadePorCaixa

                qtdOriginalBonFab = Cells(RowIndex, 15).Value2
                qntCaixaBonFab = qtdOriginalBonFab  fatorUnidadePorCaixa
                qntUnidadeBonFab = qtdOriginalBonFab Mod fatorUnidadePorCaixa

        Cells(RowIndex, 17).Value2 = qntCaixaBonRev
        Cells(RowIndex, 18).Value2 = qntUnidadeBonRev
        Cells(RowIndex, 19).Value2 = qntCaixaBonFab
        Cells(RowIndex, 20).Value2 = qntUnidadeBonFab

    Next RowIndex

End Sub

isso foi oq reparei por enquanto
para melhorar a velocidade se pode ussar array em vez do valor das celulas diretamente
assim o vba vai trabalhar na memória e não tem que pedir permissão ao excel dentro do loop

 
Postado : 07/12/2016 3:53 pm
(@edcronos2)
Posts: 346
Reputable Member
 

só para ter uma base do excesso que isso provoca sem necessidade no seu caso

vc tem um loop de 1 até 75.000
a cada estagio desse loop vc tem outro loop de 11 até 16
e a cada estagio 4 verificações de valor
isso fora o select como parasita

total do seu loop é de 75000 * {[5 * (1 select + 4 comparações )]+(4 atribuição de valores em celula)}

 
Postado : 07/12/2016 4:25 pm
 hc3
(@hc3)
Posts: 8
Active Member
Topic starter
 

a planilha está aqui:

https://drive.google.com/open?id=0B24F1 ... TNTUS0xR1U

 
Postado : 08/12/2016 6:08 am
 hc3
(@hc3)
Posts: 8
Active Member
Topic starter
 

edcronos2

hehe muito obrigado, ficou MUUUITO mais rápido assim... vlw

 
Postado : 08/12/2016 6:19 am
DJunqueira
(@djunqueira)
Posts: 772
Prominent Member
 

Solução alternativa usando Nova Consulta / Power Query.

Para testar a solução vc pode alterar o valor das colunas 'base' e ver o resultado nas colunas 'fim' após clicar com o botão direito do mouse na tabela nomeada (TBonificação) e selecionar Atualizar.
O resultado é instantâneo.

Se sua dúvida foi respondida marque o tópico como RESOLVIDO usando o botão com marca verde.

 
Postado : 08/12/2016 8:04 am