Este fórum está sendo desativado

[AfonsoMira]

Boas.

Existe algum código onde por exemplo insiro o número 2,6 numa célula e ao correr a macro ele arredonda o numero para 3, mas caso esteja 2,4 ele teria que arredondar para 2,5 e caso escreve 2,5 não arredonda.

Existe alguma for de fazer isto sem recorrer a macro?

Obrigado.

[babdallas]

Se quiser na mesma célula que digitou, só com macro. Em outra célula daria para fazer com fórmula. O que prefere?

[AfonsoMira]

Na mesma célula.

A minha ideia era criar uma macro com um Select Case.

Não sei se é boa ideia ou se existe algo mais fácil.

[babdallas]

Veja se atende.

Código: Selecionar todos

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim lng2Digitos      As Long
    
    If Not Application.Intersect(Target, wshTeste.Range("C3:F8")) Is Nothing And _
        VBA.IsNumeric(Target.Value2) Then
        lng2Digitos = (Target.Value2 - VBA.Int(Target.Value2)) * 100
        
        Application.EnableEvents = False
        If lng2Digitos > 50 Then
            Target.Value2 = VBA.Round(Target.Value2)
        Else
            Target.Value2 = VBA.Int(Target.Value2) + 0.5
        End If
        Application.EnableEvents = True
    End If
End Sub

[babdallas]

Acho que assim fica melhor.

Código: Selecionar todos

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Application.Intersect(Target, wshTeste.Range("C3:F8")) Is Nothing And _
        VBA.IsNumeric(Target.Value2) Then
        
        Application.EnableEvents = False
        
        If VBA.Round(Target.Value2) = VBA.Int(Target.Value2) + 1 Then
            Target.Value2 = VBA.Round(Target.Value2)
        Else
            Target.Value2 = VBA.Int(Target.Value2) + 0.5
        End If
        Application.EnableEvents = True
    End If
End Sub

[AfonsoMira]

Sim é isso mas quando eu insiro o número 2 ele arredonda para 2,5 e eu queria que se o número já fosse inteiro não arredondava.

Existe maneira de fazer isso? Penso que com um IF dê.

[babdallas]

Veja agora

Código: Selecionar todos

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Application.Intersect(Target, wshTeste.Range("C3:F8")) Is Nothing And _
        VBA.IsNumeric(Target.Value2) Then
        
        Application.EnableEvents = False
        
        If Target.Value2 <> VBA.Int(Target.Value2) Then
            If VBA.Round(Target.Value2) = VBA.Int(Target.Value2) + 1 Then
                Target.Value2 = VBA.Round(Target.Value2)
            Else
                Target.Value2 = VBA.Int(Target.Value2) + 0.5
            End If
            Application.EnableEvents = True
        End If
    End If
End Sub

[AfonsoMira]

Agora não está a executar a macro apenas deixa estar os números que estou a inserir.

[babdallas]

Coloquei um If a mais na resposta anterior e esqueci de alterar a posição do Application.EnableEvents = True.

Veja agora:

Código: Selecionar todos

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Application.Intersect(Target, wshTeste.Range("C3:F8")) Is Nothing And _
        VBA.IsNumeric(Target.Value2) Then
        
        Application.EnableEvents = False
        
        If Target.Value2 <> VBA.Int(Target.Value2) Then
            If VBA.Round(Target.Value2) = VBA.Int(Target.Value2) + 1 Then
                Target.Value2 = VBA.Round(Target.Value2)
            Else
                Target.Value2 = VBA.Int(Target.Value2) + 0.5
            End If
        End If
        Application.EnableEvents = True
    End If
End Sub

[AfonsoMira]

É mesmo isto!
Obrigado pela ajuda!