VBA 单一单元格的多行内容拆分为多行

2023-07-30 01:54| 来源: 网络整理| 查看: 265

多行拆分需求

假如一个单元格包含多行信息，比如说一些唯一的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

希望该方法可以帮到你，有问题评论区见，我很快会回复。

【本文地址】

公司简介

联系我们