Sub ss() Dim c As Range s = "出" For Each c In [b5:c6] For i = 2 To Len(c) If Characters(i, 1).Font.ColorIndex = xlAutomatic Then s = s & Mid(c, i, 1) End If Next Next [b1] = sEnd Sub
