Set?d?=?CreateObject("scripting.dictionary")
For?i?=?0?To?9
d(CStr(i))?=?0
Next
For?i?=?2?To?4
For?j?=?10?To?16
a?=?Cells(i,?j).Text
n?=?Len(a)
For?k?=?1?To?n
b?=?Mid(a,?k,?1)
d(b)?=?d(b)?+?1
Next
Next
Next
i?=?10
Do?While?d.Count?>?0
k?=?-1
For?Each?a?In?d.keys
If?d(a)?>?k?Then
k?=?d(a)
b?=?a
End?If
Next
Cells(14,?i)?=?b
Cells(15,?i)?=?d(b)?&?"次"
i?=?i?+?1
d.Remove?(b)
Loop
End?Sub