=TESTO(a1;"# ???/???")

Function frazioniB(ByVal a As Range, n As Single) As String
Dim b As Double, i As Long, j As Long, diff As Double, comp As Double, nom As Long, denom As Long
Dim decimali As Double, ndec As Long

b = a.Value
If n > 0 And n <= 3 Then
  ndec = CLng(String(n, "9"))
  comp = 1
  If b < (1 / 100) Then
    frazioniB = CStr(0)
  Else
    If b <> Int(b) Then
      If Int(b) = 0 Then
          frazioniB = ""
        Else
          frazioniB = Int(b) & "   "
      End If
      If b <> Int(b) Then
        decimali = b - Int(b)
        For i = 1 To ndec
          For j = 1 To ndec
            diff = Abs(i / j - decimali)
            If diff < comp Then
              nom = i
              denom = j
              comp = diff
            End If
          Next j
        Next i
      End If
      frazioniB = frazioniB & nom & "/" & denom
    Else
      frazioniB = Int(b)
    End If
  End If
Else
  frazioniB = "Err. Input"
End If
End Function

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim a As String, b As String, c As String, d As String
    If Not Intersect(Target, Range("A1")) Is Nothing Then
        Cells(2, 3) = "=LeggeTesto(A1)"
        a = Cells(2, 3).Text: If a = "" Then Exit Sub
        b = Application.WorksheetFunction.Find("/", Range("C2"))
        c = Mid(Left(a, b - 1), 2): d = Mid(a, b + 1)
        Cells(2, 3) = Fix(c / d) & " " & Abs(c Mod d) & "/" & Abs(d)
    End If
End Sub

Function LeggeTesto(RifCella As Range, Optional RifIndice As Integer) As String
Dim n As Integer, f As Integer
    RifIndice = 2
    LeggeTesto = RifCella.Formula
    n = 1: f = InStr(1, LeggeTesto, "]")
    Do While n <> 2
        If RifIndice = 1 And Mid(LeggeTesto, n, 1) = "$" Then
            LeggeTesto = Trim(Left(LeggeTesto, n - 1) & Mid(LeggeTesto, n + 1, 200))
        End If
        If Mid(LeggeTesto, n, 1) = "," Then
            LeggeTesto = Trim(Left(LeggeTesto, n) & " " & Mid(LeggeTesto, n + 1, 200))
        End If
        n = n + 1
    Loop
End Function

Function Frazione1(cella As Range) As String
Dim valcella As Variant
Dim dividendo As Variant, divisore As Variant
Dim resto As Double
valcella = Cells(cella.Row, cella.Column).Formula
dividendo = Mid(valcella, 2, 2)
divisore = Mid(valcella, 5, 5)
If dividendo / divisore - Fix(dividendo / divisore) = 0 Then
  Frazione1 = Format(dividendo / divisore, "#")
Else
  resto = (dividendo / divisore - Fix(dividendo / divisore)) * 10
  Frazione1 = Format(Fix(dividendo / divisore), "#0") & " " & Format(Fix(resto / divisore), "#/") & divisore
End If
End Function

Public Function Frazione(ByRef rng As Range) As Variant
  Frazione = Evaluate("=TEXT(" & rng.Cells(1, 1).Address & ",""# ?/??"")")
End Function

Public Function Frazione2(ByVal valSup As Double, valInf As Double) As Variant
  Frazione2 = Evaluate("=TEXT(" & valSup & "/" & valInf & ",""# ?/??"")")
End Function

Sub test()
Dim Risp1 As Integer, Risp2 As Integer, Msg As String, Num1 As Double, Num2 As Double
Dim  n, N1, N2, N3, N4
Num1 = InputBox("Inserisci numero da dividere", , 0)
Num2 = InputBox("Diviso per?", , 0)
N1 = Int(Num1 / Num2)
For n = 1 To Int(Num1 / Num2)
    If (Num2 * N2) > Num1 Then Exit For Else N3 = (Num2 * n): N4 = N4 + 1
Next n
For n = 1 To 5
    Num1 = Num1 - N3
    N2 = Num1 Mod 2
    N3 = Num2 Mod 2
    If N2 = 0 And N3 = 0 Then Msg = N1 & "  " & Num1 / 2 & "/" & Num2 / 2 Else Msg = N1 & "  " & Num1 & "/" & Num2: Exit For
Next n
Range("A2") = Msg
End Sub

Sub test2()
Dim Msg As String, Num1 As Double, Num2 As Double
Dim n, N1, N3
Num1 = InputBox("Inserisci numero da dividere", , 0)
Num2 = InputBox("Diviso per?", , 0)
N1 = Int(Num1 / Num2)
For n = 1 To Int(Num1 / Num2)
    N3 = (Num2 * n)
Next n
Num1 = Num1 - N3
Msg = N1 & " " & Num1 & "/" & Num2

Range("A2") = Msg
End Sub

Option Explicit

Function fraction(s As String)
Dim m As String, v As Variant, qz As Single, rest As String
    m = Replace(s, "", "/")
    qz = Evaluate(s)
    If Int(qz) = 0 Then
        fraction = s
    Else
        If (qz - Int(qz)) = 0 Then
            rest = ""
        Else
            rest = " 1/" & 1 / (qz - Int(qz))
        End If
        fraction = CStr(Int(qz)) & " " & rest
    End If
End Function

=SE(INT(A1/A2)<(A1/A2);INT(A1/A2)&" "&A1-(INT(A1/A2)*A2)&"/"&A2;A1/A2)

Option Explicit

Function fr$(x, Optional p% = 2) '
Dim a, b#, c#, d#, f, g00, g01, g10, g11
  fr = x
  If IsNumeric(x) Then
    c = Abs(x)
    If c > 0 And c <> Int(c) Then
      d = 10 ^ p
      b = c: a = Int(c)
      g00 = 1: g10 = 0
      g01 = a: g11 = 1
      Do While Round(a - b, 12) <> 0 And g11 < d
        b = 1 / (b - a): a = Int(b)
        f = a * g01 + g00: g00 = g01: g01 = f
        f = a * g11 + g10: g10 = g11: g11 = f
      Loop
      If g11 < d Then g00 = g01: g10 = g11
      a = Int(g00 / g10): b = g00 - a * g10
      fr = IIf(x < 0, "-", "") & IIf(g00 = 0 Or a > 0, a, "") & IIf(g10 > 1, " " & Right$(Space(p) & b, p) & "/" & Left$(g10 & Space(p), p), Space(2 * (p + 1)))
    Else
      fr = x & Space(2 * (p + 1))
    End If
  End If
End Function