Excel：vba实现拆分单元格成一字一单元格

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

要求就是：将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，列变为1
        If colindex > 4 Then
            rowindex = rowindex + 1
            colindex = 1
        End If
    Next 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 Then
   Set outputws = ThisWorkbook.Sheets.Add
   outputws.Name = "编辑后的千字文" ' 设置工作表名称为 "编辑后的千字文"
Else
   ' 清空现有内容
   outputws.Cells.Clear