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

博客围绕Excel多行拆分需求展开,若单元格含多行唯一ID信息,需将该列多行信息拆分为多行,其余列信息复制。文中提供了一个可设定的SUB子程序解决方案,给出源代码,并对代码进行了英文和中文详细注释。

摘要生成于 C知道 ,由 DeepSeek-R1 满血版支持, 前往体验 >

多行拆分需求

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

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

### WPS Excel 中将单行文本转换为多行的方法 在处理WPS Excel中的数据时,有时需要将一个单元格内的单行文本按照特定分隔符拆分为多个独立的行。虽然标准Excel功能可能不直接提供此选项,但通过一些技巧可以实现这一目标。 #### 方法一:使用Power Query(适用于较新版本) 如果使用的WPS Office版本支持Power Query,则可以通过该工具完成任务: 1. 选择含有待分割文本的列。 2. 转到`数据`菜单下的`从表格/范围`创建一个新的查询表。 3. 在Power Query编辑器中,右键点击要拆分的列并选择`拆分列` -> `按分隔符...`. 4. 输入或选择作为分隔依据的文字字符或者正则表达式模式。 5. 完成设置后应用更改并将结果加载回原始工作簿。 这种方法不仅能够高效地处理大量数据,而且还可以保留原有的结构以便后续进一步加工[^1]. #### 方法二:借助VBA宏编程自动化流程 对于熟悉Visual Basic for Applications (VBA) 的用户来说,编写一段简单的脚本可以帮助快速达成目的: ```vba Sub SplitTextIntoRows() Dim cell As Range, rng As Range Set rng = Selection ' 假设已经选择了包含要拆分文本的区域 For Each cell In rng.Cells If InStr(cell.Value, ",") > 0 Then With cell.EntireRow.Offset(1).Resize(Application.WorksheetFunction.CountA(Split(cell.Value, ","))) .Insert Shift:=xlDown Intersect(.Cells, Columns(cell.Column)).Value = Application.Transpose(Split(cell.Value, ",")) End With cell.ClearContents End If Next cell End Sub ``` 上述代码会遍历选定区域内每一个单元格,并基于逗号`,`来切割字符串内容至新的行里。请注意修改分隔符以适应具体需求. #### 方法三:利用辅助列配合函数公式 当不想改变现有布局也不想引入复杂技术的时候,可以在旁边新增加几列表达式的帮助下来间接达到效果: 1. 插入若干空白列紧挨着原数据所在位置; 2. 使用`TEXTSPLIT()` 函数(仅限于某些最新版)或者其他组合方式如`FILTERXML()`, `TRIM(MID())`等提取各个部分; 3. 复制粘贴数值形式覆盖原有单一记录形成扩展后的视图. 这种方式适合一次性操作而不追求效率的情形下采用.
评论 10
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包

打赏作者

Volavion

你的鼓励将是我创作的最大动力

¥1 ¥2 ¥4 ¥6 ¥10 ¥20
扫码支付:¥1
获取中
扫码支付

您的余额不足,请更换扫码支付或充值

打赏作者

实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值