none
Código VBA para número fracionado RRS feed

  • Pergunta

  • Prezados,

    Meus códigos de VBA numa determinada planilha estão funcionando bem a exceção de apenas um evento: quando necessito copiar e transportar um número fracionado. Exemplo:

    Quando eu digito na coluna de "Quantidade" um número inteiro, o transporte é feito sem problemas;

    Quando eu digito na coluna de "Quantidade" um número fracionado, por exemplo, 0, 450, o transporte não é feito.

    O que devo mudar?

    Gostaria também que este número, além de permitir fracionamento, tivesse sempre 3 casas depois da vírgula.

    Abaixo os códigos. Coloquei em negrito e sublinhado o que "acho" que deve ser mudado.

    Grande Abraço e antecipadamente agradeço.

    Sub Gravar_Vendas()

    Application.ScreenUpdating = False
    Dim Data As Date
    Dim Horario As Double
    Dim Atendente As Integer
    Dim NPedido As Double
    Dim NCodigo As Double
    Dim Descr As String
    Dim Unidade As String
    Dim quant As Integer
    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
     Horario = Range("K9").Value
     NPedido = Range("K13").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("E" & UltimaCel).Value = Horario
    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

    MsgBox "Venda Gravada"

    Selection.ClearContents
    Range("Q20").Select

    Application.ScreenUpdating = True
    End Sub


    Marco Antonio.

    sexta-feira, 10 de novembro de 2017 15:31

Respostas

  • Dim quant As double


    Anderson Diniz diniabr2011@gmail.com

    • Sugerido como Resposta AndersonFDiniz2 sexta-feira, 10 de novembro de 2017 15:49
    • Marcado como Resposta Marco1226 terça-feira, 14 de novembro de 2017 18:18
    sexta-feira, 10 de novembro de 2017 15:49
  • Range("K" & UltimaCel).Value = quant
    Range("K" & UltimaCel).Select
        Selection.NumberFormat = "0.000"


    Anderson Diniz diniabr2011@gmail.com

    • Sugerido como Resposta AndersonFDiniz2 sexta-feira, 10 de novembro de 2017 15:52
    • Marcado como Resposta Marco1226 terça-feira, 14 de novembro de 2017 18:18
    sexta-feira, 10 de novembro de 2017 15:52

Todas as Respostas

  • Dim quant As double


    Anderson Diniz diniabr2011@gmail.com

    • Sugerido como Resposta AndersonFDiniz2 sexta-feira, 10 de novembro de 2017 15:49
    • Marcado como Resposta Marco1226 terça-feira, 14 de novembro de 2017 18:18
    sexta-feira, 10 de novembro de 2017 15:49
  • Range("K" & UltimaCel).Value = quant
    Range("K" & UltimaCel).Select
        Selection.NumberFormat = "0.000"


    Anderson Diniz diniabr2011@gmail.com

    • Sugerido como Resposta AndersonFDiniz2 sexta-feira, 10 de novembro de 2017 15:52
    • Marcado como Resposta Marco1226 terça-feira, 14 de novembro de 2017 18:18
    sexta-feira, 10 de novembro de 2017 15:52