Initial capital customized

[snb]

Sub M_snb()
   sn = [B3:B12]
   
   For j = 1 To UBound(sn)
     sn(j, 1) = Replace(Replace(StrConv(Replace(Replace(sn(j, 1), ".", ". "), "/", "/ "), 3), ". ", "."), "/ ", "/")
     
     st = Split(sn(j, 1))
     For jj = 0 To UBound(st)
         If st(jj) Like "*[0-9]*" Then st(jj) = UCase(st(jj))
     Next
     sn(j, 1) = Join(st)
     
     For Each it In Split("di da con per mm in a e la le")
       If InStr(1, sn(j, 1) & " ", " " & it & " ", 1) Then sn(j, 1) = Trim(Replace(Replace(sn(j, 1) & " ", " " & UCase(it) & " ", " " & it & " "), " " & StrConv(it, 3) & " ", " " & it & " "))
     Next
   Next
   
   [G3:G12] = sn
End Sub

[Rick Rothstein]

Here is another macro that you can try...

Sub SpecialProperCase()
  Dim R As Long, X As Long, CellVals As Variant, Words() As String
  CellVals = Range("B3", Cells(Rows.Count, "B").End(xlUp))
  For R = 1 To UBound(CellVals)
    Words = Split(Application.Proper(CellVals(R, 1)))
    For X = 0 To UBound(Words)
      If Words(X) Like "#*" Then
        Words(X) = UCase(Words(X))
      ElseIf " di da con per mm in a e la le " Like "*[!A-Z0-9]" & LCase(Words(X)) & "[!A-Z0-9]*" Then
        Words(X) = LCase(Words(X))
      End If
    Next
    CellVals(R, 1) = Join(Words)
  Next
  Range("G3:G" & UBound(CellVals)) = CellVals
End Sub

Note: If you find there are other stand-alone words that you want to appear all lower case, add them to the space delimited list shown in blue above (but make sure the text starts and ends with a space after you have done so).