多行拆分需求
假如一个单元格包含多行信息,比如说一些唯一的ID信息,我需要将该列的这些多行信息进行拆分,将其拆分为多行,其余列信息进行复制。例如如下图所示的示例。
可以看到,该Excel表格的A列每一行都有两行的数据,而我们的目的就是把这七行进行拆分为十四行,每一行包含单元格内单行的一条信息,其余列的文件进行复制,如下图所示。
解决方案
在这里提供一个可设定的解决方案,也是一个SUB子程序。源代码如下。
Sub SplitCopyValues()
Dim arr As Variant
Dim rcount As Long
Dim ArrayLength As Integer
rcount = Cells(Rows.Count, "A").End(3).Row 'Get the row num of last row
For r = rcount To 1 Step -1 'Traverse
arr = Split(Cells(r, "A").Value, Chr(10)) 'split each item by space
ArrayLength = UBound(arr) - LBound(arr) + 1 'calculate the array length
For i = 1 To ArrayLength - 1
Rows(r & ":" & r).Copy
Rows(r + 1 & ":" & r + 1).Insert Shift:=xlDown 'insert the copied one into row+1
Next i
Cells(r, "A").Resize(ArrayLength, 1).Value = WorksheetFunction.Transpose(arr) 'Filling in the Created rows
Erase arr 'delete the arr for new one
Next r
Application.CutCopyMode = False
End Sub
SplitCopyValues主要就是满足了上述的多行拆分需求。我加了英文注释已经附在了代码里,非常简单明了,此外,为了理解和大家更改方便,我再用中文对代码进行详细注释。
在这里要注意的是Cells(Rows.Count, “A”).End(3).Row 中的3指的是向上搜索直到找到数据不同的消失位置。End()括号中的1、2、3、4分别代表向左、向右、向上、向下。END(x)表示从指定的单元格向左、向右、向上、向下最后一个有效RANGE。
下面是中文注释的代码:
Sub SplitCopyValues()
Dim arr As Variant ' arr 存储要分裂的单元格的内容
Dim rcount As Long ' rount 就是有效的行数
Dim ArrayLength As Integer ' arr的长度,n行长度就为n
'Get the row num of last row 拿到有效的行数,具体操作为:Cells(Rows.Count," A ") 拿到A列的工作簿的最底下一个单元格(包括空)
'.End(3) 的目的是从最底下的单元格向上寻找,找到第一个非空的单元格
'.Row的目的是记录刚刚那个单元格的行数
rcount = Cells(Rows.Count, "A").End(3).Row
For r = rcount To 1 Step -1 'Traverse 对每行的行数进行循环,从最后往前进行遍历
arr = Split(Cells(r, "A").Value, Chr(10)) 'split each item by space 将该单元格以Chr(10)为分隔符进行分割
ArrayLength = UBound(arr) - LBound(arr) + 1 'calculate the array length 计算分割后的ARR的长度
For i = 1 To ArrayLength - 1 '对Arr内的每个元素进行遍历
Rows(r & ":" & r).Copy '将该行进行复制
Rows(r + 1 & ":" & r + 1).Insert Shift:=xlDown 'insert the copied one into row+1 '把复制的行插入到该单元格所在行的下一行
Next i
Cells(r, "A").Resize(ArrayLength, 1).Value = WorksheetFunction.Transpose(arr) 'Filling in the Created rows 将arr转置为列后插入到刚刚生成的哪些新的行中,也就是把A列填好
Erase arr 'delete the arr for new one
Next r
Application.CutCopyMode = False '这是为了防止大规模复制粘贴而弹出系统默认的对话框
End Sub
希望该方法可以帮到你,有问题评论区见,我很快会回复。