none
Lentidão na Macro RRS feed

 > 

  • Pergunta

  • Question
    Entrar para Votar
    0
    Entrar para Votar

    Prezados,

    Tenho uma macro (veja abaixo) que está muito lenta (quase 2 minutos). Funciona perfeitamente porém com muito lentidão.  O que posso fazer para melhorar o tempo de processamento?

    Option Explicit

    Sub chamarGravarRecebimentoMesa1()

    Call Gravar_Recebimento_mesa("Mesa1")


    MsgBox "Gravado com sucesso"

    End Sub

    Sub chamarGravarRecebimentoMesa2()

    Call Gravar_Recebimento_mesa("Mesa2")


    MsgBox "Gravado com sucesso"

    End Sub
    Sub chamarGravarRecebimentoMesa3()

    Call Gravar_Recebimento_mesa("Mesa3")


    MsgBox "Gravado com sucesso"

    End Sub

    Sub chamarGravarRecebimentoMesa4()

    Call Gravar_Recebimento_mesa("Mesa4")


    MsgBox "Gravado com sucesso"

    End Sub
    Sub chamarGravarRecebimentoMesa5()

    Call Gravar_Recebimento_mesa("Mesa5")


    MsgBox "Gravado com sucesso"

    End Sub
    Sub chamarGravarRecebimentoMesa6()

    Call Gravar_Recebimento_mesa("Mesa6")


    MsgBox "Gravado com sucesso"

    End Sub

    Sub chamarGravarRecebimentoMesa7()

    Call Gravar_Recebimento_mesa("Mesa7")


    MsgBox "Gravado com sucesso"

    End Sub
    Sub chamarGravarRecebimentoMesa8()

    Call Gravar_Recebimento_mesa("Mesa8")


    MsgBox "Gravado com sucesso"

    End Sub

    Sub chamarGravarRecebimentoMesa9()

    Call Gravar_Recebimento_mesa("Mesa9")


    MsgBox "Gravado com sucesso"

    End Sub
    Sub chamarGravarRecebimentoMesa10()

    Call Gravar_Recebimento_mesa("Mesa10")


    MsgBox "Gravado com sucesso"

    End Sub

    Sub chamarGravarRecebimentoMesa11()

    Call Gravar_Recebimento_mesa("Mesa11")


    MsgBox "Gravado com sucesso"

    End Sub
    Sub chamarGravarRecebimentoMesa12()

    Call Gravar_Recebimento_mesa("Mesa12")


    MsgBox "Gravado com sucesso"

    End Sub

    Sub chamarGravarRecebimentoMesa13()

    Call Gravar_Recebimento_mesa("Mesa13")


    MsgBox "Gravado com sucesso"

    End Sub
    Sub chamarGravarRecebimentoMesa14()

    Call Gravar_Recebimento_mesa("Mesa14")


    MsgBox "Gravado com sucesso"

    End Sub
    Sub chamarGravarRecebimentoMesa15()

    Call Gravar_Recebimento_mesa("Mesa15")


    MsgBox "Gravado com sucesso"

    End Sub

    Sub chamarGravarRecebimentoMesa16()

    Call Gravar_Recebimento_mesa("Mesa16")


    MsgBox "Gravado com sucesso"

    End Sub
    Sub chamarGravarRecebimentoMesa17()

    Call Gravar_Recebimento_mesa("Mesa17")


    MsgBox "Gravado com sucesso"

    End Sub

    Sub chamarGravarRecebimentoMesa18()

    Call Gravar_Recebimento_mesa("Mesa18")


    MsgBox "Gravado com sucesso"

    End Sub
    Sub chamarGravarRecebimentoMesa19()

    Call Gravar_Recebimento_mesa("Mesa19")


    MsgBox "Gravado com sucesso"

    End Sub

    Sub chamarGravarRecebimentoMesa20()

    Call Gravar_Recebimento_mesa("Mesa20")


    MsgBox "Gravado com sucesso"

    End Sub
    Sub chamarGravarRecebimentoMesa21()

    Call Gravar_Recebimento_mesa("Mesa21")


    MsgBox "Gravado com sucesso"

    End Sub

    Sub chamarGravarRecebimentoMesa22()

    Call Gravar_Recebimento_mesa("Mesa22")


    MsgBox "Gravado com sucesso"

    End Sub
    Sub chamarGravarRecebimentoMesa23()

    Call Gravar_Recebimento_mesa("Mesa23")


    MsgBox "Gravado com sucesso"

    End Sub

    Sub chamarGravarRecebimentoMesa24()

    Call Gravar_Recebimento_mesa("Mesa24")


    MsgBox "Gravado com sucesso"

    End Sub
    Sub chamarGravarRecebimentoMesa25()

    Call Gravar_Recebimento_mesa("Mesa25")


    MsgBox "Gravado com sucesso"

    End Sub

    Sub chamarGravarRecebimentoMesa26()

    Call Gravar_Recebimento_mesa("Mesa26")


    MsgBox "Gravado com sucesso"

    End Sub
    Sub chamarGravarRecebimentoMesa27()

    Call Gravar_Recebimento_mesa("Mesa27")


    MsgBox "Gravado com sucesso"

    End Sub
    Sub chamarGravarRecebimentoMesa28()

    Call Gravar_Recebimento_mesa("Mesa28")


    MsgBox "Gravado com sucesso"

    End Sub

    Sub chamarGravarRecebimentoMesa29()

    Call Gravar_Recebimento_mesa("Mesa29")


    MsgBox "Gravado com sucesso"

    End Sub
    Sub chamarGravarRecebimentoMesa30()

    Call Gravar_Recebimento_mesa("Mesa30")


    MsgBox "Gravado com sucesso"

    End Sub

    Sub chamarGravarRecebimentoMesa31()

    Call Gravar_Recebimento_mesa("Mesa31")


    MsgBox "Gravado com sucesso"

    End Sub
    Sub chamarGravarRecebimentoMesa32()

    Call Gravar_Recebimento_mesa("Mesa32")


    MsgBox "Gravado com sucesso"

    End Sub

    Sub chamarGravarRecebimentoMesa33()

    Call Gravar_Recebimento_mesa("Mesa33")


    MsgBox "Gravado com sucesso"

    End Sub
    Sub chamarGravarRecebimentoMesa34()

    Call Gravar_Recebimento_mesa("Mesa34")


    MsgBox "Gravado com sucesso"

    End Sub

    Sub chamarGravarRecebimentoMesa35()

    Call Gravar_Recebimento_mesa("Mesa35")


    MsgBox "Gravado com sucesso"

    End Sub
    Sub chamarGravarRecebimentoMesa36()

    Call Gravar_Recebimento_mesa("Mesa36")


    MsgBox "Gravado com sucesso"

    End Sub
    Sub chamarGravarRecebimentoMesa37()

    Call Gravar_Recebimento_mesa("Mesa37")


    MsgBox "Gravado com sucesso"

    End Sub

    Sub chamarGravarRecebimentoMesa38()

    Call Gravar_Recebimento_mesa("Mesa38")


    MsgBox "Gravado com sucesso"

    End Sub
    Sub chamarGravarRecebimentoMesa39()

    Call Gravar_Recebimento_mesa("Mesa39")


    MsgBox "Gravado com sucesso"

    End Sub

    Sub chamarGravarRecebimentoMesa40()

    Call Gravar_Recebimento_mesa("Mesa40")


    MsgBox "Gravado com sucesso"

    End Sub
    Sub chamarGravarRecebimentoMesa41()

    Call Gravar_Recebimento_mesa("Mesa41")


    MsgBox "Gravado com sucesso"

    End Sub

    Sub chamarGravarRecebimentoMesa42()

    Call Gravar_Recebimento_mesa("Mesa42")


    MsgBox "Gravado com sucesso"

    End Sub
    Sub chamarGravarRecebimentoMesa43()

    Call Gravar_Recebimento_mesa("Mesa43")


    MsgBox "Gravado com sucesso"

    End Sub

    Sub chamarGravarRecebimentoMesa44()

    Call Gravar_Recebimento_mesa("Mesa44")


    MsgBox "Gravado com sucesso"

    End Sub
    Sub chamarGravarRecebimentoMesa45()

    Call Gravar_Recebimento_mesa("Mesa45")


    MsgBox "Gravado com sucesso"

    End Sub

    Sub chamarGravarRecebimentoMesa46()

    Call Gravar_Recebimento_mesa("Mesa46")


    MsgBox "Gravado com sucesso"

    End Sub
    Sub chamarGravarRecebimentoMesa47()

    Call Gravar_Recebimento_mesa("Mesa47")


    MsgBox "Gravado com sucesso"

    End Sub

    Sub chamarGravarRecebimentoMesa48()

    Call Gravar_Recebimento_mesa("Mesa48")


    MsgBox "Gravado com sucesso"

    End Sub
    Sub chamarGravarRecebimentoMesa49()

    Call Gravar_Recebimento_mesa("Mesa49")


    MsgBox "Gravado com sucesso"

    End Sub
    Sub chamarGravarRecebimentoMesa50()

    Call Gravar_Recebimento_mesa("Mesa50")


    MsgBox "Gravado com sucesso"

    End Sub

    Sub chamarGravarRecebimentoMesa51()

    Call Gravar_Recebimento_mesa("Mesa51")


    MsgBox "Gravado com sucesso"

    End Sub
    Sub chamarGravarRecebimentoMesa52()

    Call Gravar_Recebimento_mesa("Mesa52")


    MsgBox "Gravado com sucesso"

    End Sub

    Sub chamarGravarRecebimentoMesa53()

    Call Gravar_Recebimento_mesa("Mesa53")


    MsgBox "Gravado com sucesso"

    End Sub
    Sub chamarGravarRecebimentoMesa54()

    Call Gravar_Recebimento_mesa("Mesa54")


    MsgBox "Gravado com sucesso"

    End Sub

    Sub chamarGravarRecebimentoMesa55()

    Call Gravar_Recebimento_mesa("Mesa55")


    MsgBox "Gravado com sucesso"

    End Sub
    Sub chamarGravarRecebimentoMesa56()

    Call Gravar_Recebimento_mesa("Mesa56")


    MsgBox "Gravado com sucesso"

    End Sub


    Sub Gravar_Recebimento_mesa(ByVal nome As String)

    Application.ScreenUpdating = False
    Dim Data As Date
    Dim NPedido As Double
    Dim Total As Double
    Dim Forma As String
    Dim Recebido As Double
    Dim Troco As Double
    Dim Mesa As Double
    Dim UltimaCel As Integer

    Dim QuantDados As Integer
    Dim linha As Integer

    QuantDados = Sheets(nome).Range("u4").End(xlUp).Row
    linha = 3
    While linha < QuantDados + 1

    Sheets(nome).Select
     Data = Range("V9").Value
     NPedido = Range("t9").Value
     Total = Range("V13").Value
     Forma = Range("U3").Value
     Recebido = Range("V3").Value
     Troco = Range("V4").Value
     Mesa = Range("M9").Value
     
    Sheets("Recebimento").Select

    UltimaCel = Range("D65000").End(xlUp).Row + 1

    Range("D" & UltimaCel).Value = Data
    Range("F" & UltimaCel).Value = NPedido
     Range("G" & UltimaCel).Value = Total
     Range("H" & UltimaCel).Value = Forma
     Range("I" & UltimaCel).Value = Recebido
     Range("j" & UltimaCel).Value = Troco
     Range("K" & UltimaCel).Value = Mesa
     
     linha = linha + 1
    Wend

    Sheets(nome).Select
    Range("T13").Value = Range("T13").Value + 1


    Application.ScreenUpdating = True
    End Sub

    Marco Antonio.

    quinta-feira, 23 de novembro de 2017 18:21
    |

Respostas