none
Inserir fórmulas numa macro RRS feed

  • Pergunta

  • Prezados boa tarde,

    Gostaria de inserir algumas fórmulas (relacionadas abaixo) na macro que uso (mais abaixo) de forma que toda linha seja preenchida. O objetivo e fazer com que o arquivo fique menos pesado.

    Alguém poderia me ajudar?

    Grato.

    As fórmulas:

    =SE(T5>0;"Cancelado";0)

    =SEERRO(SE(G5=0;0;PROCV(C5;Recebimento!$C$5:$C$5000;1;FALSO));"Sem Receber")

    =SEERRO(SE(C5<>0;CORRESP(C5;Cancelamentos!$C$6:$C$500;0);0);0)

    =SE($T5>0;0;K5)

    SE(P5="Sem Receber";1;0)

    A Macro:

     

    Sub Gravar_Vendas()


    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    Dim Data As Date
    Dim Atendente As Integer
    Dim NPedido As Double
    Dim NCodigo As Double
    Dim Descr As String
    Dim Unidade As String
    Dim quant As Double
    Dim Desc As Double
    Dim Preco As Double
    Dim Total As Double
    Dim UltimaCel As Integer

    Dim QuantDados As Integer
    Dim linha As Integer

    QuantDados = Sheets("Vendas").Range("E32").End(xlUp).Row
    linha = 17
    While linha < QuantDados + 1

    Sheets("Vendas").Select
     Data = Range("K7").Value
     NPedido = Range("R1").Value
     Atendente = Range("F7").Value
     NCodigo = Range("E" & linha).Value
     Descr = Range("F" & linha).Value
     Unidade = Range("G" & linha).Value
     quant = Range("H" & linha).Value
     Desc = Range("I" & linha).Value
     Preco = Range("J" & linha).Value
     Total = Range("K" & linha).Value

    Sheets("Relatório").Select

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

    Range("D" & UltimaCel).Value = Data
    Range("F" & UltimaCel).Value = Atendente
     Range("G" & UltimaCel).Value = NPedido
     Range("H" & UltimaCel).Value = NCodigo
     Range("I" & UltimaCel).Value = Descr
     Range("j" & UltimaCel).Value = Unidade
     Range("K" & UltimaCel).Value = quant
     Range("L" & UltimaCel).Value = Desc
     Range("M" & UltimaCel).Value = Preco
     Range("N" & UltimaCel).Value = Total
     linha = linha + 1
    Wend

    Sheets("Vendas").Select
    Range("R1").Value = Range("R1").Value + 1



    MsgBox "Venda Gravada"


    Range("Q20").Select
    Selection.ClearContents



    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

    End Sub

    Muito obrigado!

    Marco.


    Marco Antonio.

    segunda-feira, 11 de dezembro de 2017 18:12

Respostas