Sub d()
For i = 1 To Range("b25356").End(xlUp).Row
Range("f" & i) = Range("a" & i)
Range("g" & i) = Range("b" & i)
Range("h" & i) = Range("c" & i)
Range("i" & i) = Range("d" & i)
For RRow = 1 To Len(Range("d" & i))
If i <> 1 Then
Range("f" & j + RRow + 1) = Range("a" & i)
Range("g" & j + RRow + 1) = Range("b" & i)
Range("h" & j + RRow + 1) = Range("c" & i)
If Range("d" & i) <> "选项" Then
Range("i" & j + RRow + 1) = Mid(Range("d" & i), RRow, 1)
End If
End If
Next RRow
If i <> 1 Then
j = j + Len(Range("d" & i))
End If
Next i
End Sub
