我拿到的表格如下：                                             我想实现的表格效果如下：

 
要求就是：将A列的千字文拆分成一个单元格一个字，并整理成4列

我这里是将效果呈现到一个新的表里面，没有在原表里面(在原表里面孩子不会用vba实现！！)

---

代码如下：

Sub edit()
Dim ws As Worksheet
Dim outputws As Worksheet
Dim i As Long
Dim j As Long
Dim cellValue As String
Dim str As String
Dim s As String
Dim rowindex As Integer
Dim colindex As Integer'想要进行编辑的工作表
Set ws = ThisWorkbook.Sheets("千字文")'可以先创建一个表用于存放输出数据，一定要确保这个工作表是存在的，不然会报错
Set outputws = ThisWorkbook.Sheets("编辑后的千字文")'获取当前工作表的最后一行，一定不要忘了ws
lastrow = ws.Cells(Rows.Count, 1).End(xlUp).Row
rowindex = 1 '初始化行
colindex = 1 '初始化列For i = 1 To lastrow'获取当前工作表中的每一个单元格里面的值cellValue = ws.Cells(i, 1).Value'先用Replace函数将单元格字符串中的空格去掉，然后用Trim函数将首尾的空格去掉str = Trim(Replace(cellValue, " ", ""))'用Len函数获取字符串的长度strLength = Len(str)For j = 1 To strLength'获取字符串的每一个字符s = Mid(str, j, 1)'将字符写入新表里面，根据要求4列为一行outputws.Cells(rowindex, colindex).Value = s'行不变，列变colindex = colindex + 1'如果列大于4，换行，行数加1，列变为1If colindex > 4 Thenrowindex = rowindex + 1colindex = 1End IfNext j
Next i
End Sub

我觉得自己手动新建一个表比用vba代码建一个表要容易
如果想用vba新建得话添加的代码如下：
下面的代码替换上面的set outputws=ThisWorkbook.Sheets("编辑后的千字文")

'这行代码告诉 VBA 在执行后续代码时，如果遇到错误，不要中断程序的执行    
On Error Resume Next'这行代码尝试将名为 "编辑后的千字文" 的工作表赋值给变量 outputWs
Set outputws = ThisWorkbook.Sheets("编辑后的千字文")'从这一行开始，如果后续代码发生错误，VBA 将会停止执行并显示错误信息。
On Error GoTo 0'这行代码检查变量 outputws 是否为 Nothing。如果 outputws 是 Nothing，则说明"编辑后的千字文"工作表不存在，不存在就创建
If outputws Is Nothing ThenSet outputws = ThisWorkbook.Sheets.Addoutputws.Name = "编辑后的千字文" ' 设置工作表名称为 "编辑后的千字文"
Else' 清空现有内容outputws.Cells.Clear