Option Explicit Sub abc() Dim a, i, j, t a = [a1].CurrentRegion.Offset(1).Resize(, 1).Value For i = 1 To UBound(a) - 1 t = Split(a(i, 1), "、") For j = 0 To UBound(t) t(j) = j + 1 & t(j) Next a(i, 1) = Join(t, "、") Next [b2].Resize(UBound(a) - 1) = a End Sub