السلام عليكم
جرب هذا الكود
Sub MyNmbr()
Dim i As Byte, MyRng As Range, Lr As Long, j As Long
Lr = Cells(Rows.Count, "A").End(xlUp).Row
For j = 2 To Lr
Set MyRng = Cells(j, 2)
For i = 1 To Len(MyRng)
If IsNumeric(Mid(MyRng, i, 1)) = True Then
rr = Application.WorksheetFunction.Max(Mid(MyRng, i, 1))
End If
Next
Next
MsgBox rr
End Sub