我拿到的表格如下: 我想实现的表格效果如下:
要求就是:将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