☰

将单元格拆分为行

tag-icon • tag-icon microsoft-excel
将单元格拆分为行

假设在 A1 单元格中我有一些用逗号分隔的字母。

content(A1 cell) = A, W, L, F

我想要得到以下结果：

content(A2 cell) = A
content(A3 cell) = W
content(A4 cell) = L
content(A5 cell) = F

但是如果我在 A1 单元格中输入以下内容：

content(A1 cell) = S, E, U, F, H, R, T

我希望的结果是：

content(A2 cell) = S
content(A3 cell) = E
content(A4 cell) = U
content(A5 cell) = F
content(A6 cell) = H
content(A7 cell) = R
content(A8 cell) = T

是否有函数可以完成这项工作？例如，我想在 B1 单元格中设置一个函数公式，该公式检查 A1 单元格的内容，其输出将是上述结果。任何帮助都非常感谢。

答案1

公式

=INDEX(MID(SUBSTITUTE($A$1,", ",""),ROW($A$1:INDIRECT("a"&LEN(SUBSTITUTE($A$1,", ","")))),1),ROWS($A$1:A1))

答案2

将单元格拆分为行

函数无法按照你在问题中描述的方式工作，但这里有一个“类似”虚拟专用网络解决方案使用工作表更改事件。

强调

  • 你Worksheet_Change可以选择（提供）拆分单元格范围地址包含分隔数据 ( cStrCell) 和分割分隔符（cStrDel）。
  • 当更改拆分单元格范围，解决方案将复制拆分单元格范围进入 分割数据范围并删除以下所有数据。
  • 任何细胞的变化分割数据范围不可能。

在此处输入图片描述

复制以下代码到需要的工作表代码窗口例如 Sheet1(Code)。

代码

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    Const cStrCell As String = "A1"   ' Split Cell Range Address
    Const cStrDel As String = ","     ' Split Delimiter

    Application.EnableEvents = False

    ' Check if changed cell range is contained in Split Range.
    If Not Intersect(Target, Range(cStrCell).Resize(UBound(Split( _
            Range(cStrCell), cStrDel)) + 2)) Is Nothing Then

        On Error GoTo ProcedureExit

        ' Check if changed cell range address
        ' is equal to Split Cell Range Address.
        If Target.Address = Range(cStrCell).Address Then
            ' Clear contents of data below Split Range.
            Range(Range(cStrCell).Offset(1), Cells(Rows.Count, _
                    Range(cStrCell).Column).End(xlUp)).ClearContents
        End If

        ' Fill Split Range with Split Data
        ' i.e. copy Split Data below Split Cell Range.
        SplitToRows Range(cStrCell), cStrDel

    End If

ProcedureExit:
    Application.EnableEvents = True

End Sub

Sub SplitToRows(SplitCellRange As Range, Optional Delimiter As String = ",")

    Dim vntS As Variant   ' Source Array
    Dim vntT As Variant   ' Target Array
    Dim i As Long         ' Arrays Row Counter

    ' Split first cell in SplitCellRange by Delimiter into Source Array.
    vntS = Split(SplitCellRange.Cells(1, 1), Delimiter)

    ' Resize 2D one-based Target Array.
    ReDim vntT(1 To UBound(vntS) + 1, 1 To 1)

    ' Trim and copy from Source to Target Array.
    For i = 0 To UBound(vntS)
        vntT(i + 1, 1) = Trim(vntS(i))
    Next

    ' Copy Target Array to Target Range below SplitCellRange.
    SplitCellRange.Cells(1, 1).Offset(1).Resize(UBound(vntT)) = vntT

End Sub

相关内容