AMORIM123

SOLUÇÃO: Private Sub CommandButton1_Click() sval1 = TextBox1.Value sval2 = txt_desc.Value If VBA.Round(sval1 / sval2, 2) = 0# Then txtResultado = Format(VBA.Round((sval1 / sval2) * 10000, 2), "0.00") & "%" Else txtResultado = Format(VBA.Round((sval1 / sval2) * 100, 2), "0.00") & "%" End If End Sub

Eis me aqui novamente meus caros. Dessa vez trago a seguinte questão: Private Sub CommandButton1_Click() sVal1 = TextBox1.Value sVal2 = txt_desc.Value '1º caso - txtResultado = Format(Round(Round((sVal1 / sVal2) * 100, 4) * 100, 2)) & "%" 'como faço para aplicar este metodo de calculo quando o resulta da divisão de sVal1/sVal2 tiver dois 00 após a virgula - exemplo 0,002780 '2º caso - txtResultado = Format(Round(Round((sVal1 / sVal2) * 100, 4), 2)) & "%" 'como faço para aplicar este metodo de calculo quando o resulta da divisão de sVal1/sVal2 não contiver zeros após a virgula - exemplo 0,3272 End Sub na realidade o que eu quero é uma forma em que quando dividisse meu sVal1 / sVal2, independente do valor (lógico, obedecendo a lógica de cálculo de porcentagem, menor pelo maior), o valor visualizado no "txtResultado" fosse uma porcentagem com duas casas decimais após a virgula, pois se eu calcular o "Exemplo1" com o "1º caso" do código o resultado será 27,73%, todavia se realizar o calculo do "Exemplo1" com o "2º caso" o resultado será 0,28% e vise-versa. Exemplo1→ 22.000,00/7.931.000,00 = 0,002773 se eu utilizar o "1 - caso" terei como resultado 27,73% Porém se calcular: Exemplo2= 21.600,00/66.000,00 = 3272,73% (1º caso); se eu utilizar o "2 - caso" terei como resultado 32,72% - e ai teria "o solicitado", isto é, um resulta exibindo em porcentagem, com duas casas decimais após a virgula Espero ter sido objetivo! Em anexo a planilha! quem puder contribuir com algum raciocínio ou exemplo de outro código de outras planilhas serei muito grato! calculo.rar

Salve, salve galera do fórum! No código abaixo do meu btn_SALVAR tenho instrução para salvamento dos dados constantes dos meus txtbox do meu frm_anexo, porém antes de salvar são requeridas algumas validações, como a verificação se já há algum registro semelhante, tendo como parâmetro de comparação apenas os dados da coluna A, e a opção de sobrescreve-lo, após "vbyes", tá dando erro de execução, antes estavam dando outros erros não consegui ver nada de errado na compilação. Gostaria da ajuda do pessoal aqui do fórum para resolver este problema. Aquém puder ajudar meu muito obrigado! Planilha anexa! Private Sub btn_salvar_click() Dim plan As Worksheet Dim quantidade As Range Dim frm As frm_anexo Dim periodo As Integer Dim folha As Integer Dim faturamento As Integer Dim linha As Integer Dim busca As String Dim reposta As String Set plan = Sheets("Plan1").Select Set frm = frm_anexo Set quantidade = plan.Range(Rows.Count & "A").End(xlUp).Offset(1, 0) linha = 2 periodo = frm.txt_periodo.Text folha = frm.txt_folha.Text faturamento = frm.txt_faturamento.Text plan.Range("A2").Select Do While ActiveCell.Row <> "" busca = ActiveCell.Value If busca = periodo Then resposta = MsgBox("Período " & periodo & "já cadastrado, deseja sobrescreve-lo?!", vbYesNo) If resposta = vbYes Then ActiveCell.Value = periodo ActiveCell.Offset(2, 0).Value = folha ActiveCell.Offset(3, 0).Value = faturamento End If Exit Sub Else linha = linha + 1 Exit Sub 'aqui End If ActiveCell.Offset(1, 0).Select Loop If Me.txt_periodo = "" Then MsgBox ("Preenchimento imconpleto! Insira Período"), vbExclamation, aviso Me.txt_periodo.SetFocus Exit Sub ElseIf Me.txt_folha = "" Then MsgBox ("Preenchimento imconpleto! Insira Folha"), vbExclamation, aviso Me.txt_folha.SetFocus Exit Sub ElseIf Me.txt_faturamento = "" Then MsgBox ("Preenchimento imconpleto! Insira Fturamento"), vbExclamation, aviso Me.txt_faturamento.SetFocus Exit Sub End If quantidade.Select ActiveCell.Value = periodo ActiveCell.Offset(0, 2).Value = folha ActiveCell.Offset(0, 3).Value = faturamento resposta = MsgBox("Dados cadastrados com sucesso! Deseja cadastratar novo registro?!", vbYesNo) If resposta = vbYes Then frm.btn_salvar.Enabled = True Exit Sub ElseIf resposta = vbNo Then frm.btn_salvar.Enabled = False Exit Sub End If Unload frm_anexo frm_anexo.Show End Sub MODELO SIMPLES NACIONAL 2018 - Anexo III e V.rar